mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-10 11:23:15 +00:00
6d1bc24d0b
Estimated hours taken: 4 Branches: main compiler/prog_data.m: Make vartypes an abstract data type, in preparation for exploring better representations for it. compiler/mode_util.m: Provide two different versions of a predicate. The generic version continues to use map lookups. The other version knows it works on prog_vars, so it can use the abstract operations on them provided by prog_data.m. compiler/accumulator.m: compiler/add_class.m: compiler/add_heap_ops.m: compiler/add_pragma.m: compiler/add_pred.m: compiler/add_trail_ops.m: compiler/arg_info.m: compiler/builtin_lib_types.m: compiler/bytecode_gen.m: compiler/call_gen.m: compiler/clause_to_proc.m: compiler/closure_analysis.m: compiler/code_info.m: compiler/common.m: compiler/complexity.m: compiler/const_prop.m: compiler/constraint.m: compiler/continuation_info.m: compiler/cse_detection.m: compiler/ctgc.datastruct.m: compiler/ctgc.util.m: compiler/deep_profiling.m: compiler/deforest.m: compiler/dep_par_conj.m: compiler/det_analysis.m: compiler/det_report.m: compiler/det_util.m: compiler/disj_gen.m: compiler/equiv_type_hlds.m: compiler/erl_call_gen.m: compiler/erl_code_gen.m: compiler/erl_code_util.m: compiler/exception_analysis.m: compiler/float_regs.m: compiler/follow_vars.m: compiler/format_call.m: compiler/goal_path.m: compiler/goal_util.m: compiler/hhf.m: compiler/higher_order.m: compiler/hlds_clauses.m: compiler/hlds_goal.m: compiler/hlds_out_goal.m: compiler/hlds_out_pred.m: compiler/hlds_pred.m: compiler/hlds_rtti.m: compiler/inlining.m: compiler/instmap.m: compiler/intermod.m: compiler/interval.m: compiler/lambda.m: compiler/lco.m: compiler/live_vars.m: compiler/liveness.m: compiler/lookup_switch.m: compiler/mercury_to_mercury.m: compiler/ml_accurate_gc.m: compiler/ml_closure_gen.m: compiler/ml_code_gen.m: compiler/ml_code_util.m: compiler/ml_disj_gen.m: compiler/ml_lookup_switch.m: compiler/ml_proc_gen.m: compiler/ml_unify_gen.m: compiler/mode_info.m: compiler/modecheck_call.m: compiler/modecheck_conj.m: compiler/modecheck_goal.m: compiler/modecheck_unify.m: compiler/modecheck_util.m: compiler/modes.m: compiler/par_loop_control.m: compiler/pd_info.m: compiler/pd_util.m: compiler/polymorphism.m: compiler/post_typecheck.m: compiler/prog_type_subst.m: compiler/prop_mode_constraints.m: compiler/purity.m: compiler/qual_info.m: compiler/rbmm.points_to_info.m: compiler/rbmm.region_liveness_info.m: compiler/rbmm.region_transformation.m: compiler/saved_vars.m: compiler/simplify.m: compiler/size_prof.m: compiler/ssdebug.m: compiler/stack_alloc.m: compiler/stack_opt.m: compiler/store_alloc.m: compiler/structure_reuse.analysis.m: compiler/structure_reuse.direct.choose_reuse.m: compiler/structure_reuse.direct.detect_garbage.m: compiler/structure_reuse.indirect.m: compiler/structure_sharing.analysis.m: compiler/structure_sharing.domain.m: compiler/switch_detection.m: compiler/table_gen.m: compiler/term_constr_build.m: compiler/term_constr_util.m: compiler/term_traversal.m: compiler/term_util.m: compiler/trace_gen.m: compiler/trailing_analysis.m: compiler/try_expand.m: compiler/tupling.m: compiler/type_constraints.m: compiler/type_util.m: compiler/typecheck.m: compiler/typecheck_errors.m: compiler/typecheck_info.m: compiler/unify_gen.m: compiler/unify_proc.m: compiler/unique_modes.m: compiler/untupling.m: compiler/unused_args.m: compiler/var_locn.m: Conform to the above. compiler/prog_type.m: compiler/rbmm.points_to_graph.m: Conform to the above. Move some comments where they belong. compiler/stm_expand.m: Conform to the above. Do not export a predicate that is not used outside this module. Disable some debugging output unless it is asked for. Remove unnecessary prefixes on variable names. library/version_array.m: Instead writing code for field access lookalike functions and defining lookup, set etc in terms of them, write code for lookup, set etc, and define the field access lookalike functions in terms of them. Change argument orders of some internal predicates to be more state variable friendly. Fix typos in comments. tests/hard_coded/version_array_test.exp: Conform to the change to version_array.m.
2184 lines
84 KiB
Mathematica
2184 lines
84 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2005-2008, 2010-2012 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: structure_sharing.domain.m.
|
|
% Main author: nancy.
|
|
%
|
|
% This module defines the abstract domain for representing structure sharing
|
|
% between data structures.
|
|
%
|
|
% This domain forms a complete lattice. It has a bottom element (representing
|
|
% the definite absence of any possible structure sharing), and a top element
|
|
% (that represents any possible structure sharing), a least upper bound
|
|
% operation, and a comparison predicate (is_subsumed_by).
|
|
%
|
|
% The auxiliary functions needed for using the domain within the abstract
|
|
% semantics on which the implementation of the analysis is based are:
|
|
%
|
|
% * project: limit the abstract information to include only the
|
|
% information regarding some given set of variables.
|
|
%
|
|
% * rename: given a mapping of variables, this operation renames every
|
|
% occurrence of a variable to its mapping.
|
|
%
|
|
% * init: create an initial empty sharing set that represents the absence
|
|
% of any possible sharing.
|
|
%
|
|
% * comb: combine new sharing information (that usually stems from a
|
|
% procedure call) with existing sharing such that the result correctly
|
|
% approximates the real sharing that would exist when new concrete
|
|
% sharing is added to existing sharing.
|
|
%
|
|
% * add: add the sharing created by a primitive operation (unification)
|
|
% to any existing sharing.
|
|
%
|
|
% Additional operations:
|
|
%
|
|
% * extend_datastruct: compute the set of datastructures referring to the
|
|
% same memory space as a given datastructure, using sharing information;
|
|
% needed by the reuse analysis to check whether a given datastructure is
|
|
% the last pointer to the memory space it refers to.
|
|
%
|
|
% * conversion operations between the public and private representation
|
|
% for sharing sets.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module transform_hlds.ctgc.structure_sharing.domain.
|
|
:- interface.
|
|
|
|
:- import_module analysis.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module bool.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module set.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% The hidden representation for structure sharing.
|
|
%
|
|
:- type sharing_as.
|
|
|
|
% Operations w.r.t. the "bottom" element of the lattice.
|
|
%
|
|
:- func sharing_as_init = sharing_as.
|
|
:- pred sharing_as_is_bottom(sharing_as::in) is semidet.
|
|
|
|
% Operations w.r.t. the "top" element of the lattice. When sharing
|
|
% becomes top, it is useful to know why it has become top.
|
|
%
|
|
:- func sharing_as_top_no_feedback = sharing_as.
|
|
:- func sharing_as_top_sharing(top_feedback) = sharing_as.
|
|
:- func sharing_as_top_sharing_accumulate(top_feedback, sharing_as)
|
|
= sharing_as.
|
|
:- pred sharing_as_is_top(sharing_as::in) is semidet.
|
|
|
|
% Return the size of the sharing set. Fail when sharing is top.
|
|
%
|
|
:- func sharing_as_size(sharing_as) = int is semidet.
|
|
|
|
% Return a short description of the sharing information.
|
|
%
|
|
:- func sharing_as_short_description(sharing_as) = string.
|
|
|
|
% Projection operation.
|
|
% This operation reduces the sharing information to information
|
|
% regarding a given set of variables only.
|
|
% Some properties of a call `project(Vars, SharingIn, SharingOut)':
|
|
% * vars(SharingOut) is a subset of Vars.
|
|
% * vars(SharingIn minus SharingOut) union Vars = emptyset.
|
|
%
|
|
:- pred sharing_as_project(prog_vars::in,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
:- func sharing_as_project(prog_vars, sharing_as) = sharing_as.
|
|
:- pred sharing_as_project_set(set(prog_var)::in,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
|
|
% Renaming operation.
|
|
% This operation renames the variables and type variables occurring
|
|
% in the sharing information according to a variable and type variable
|
|
% mapping.
|
|
%
|
|
:- pred sharing_as_rename(prog_var_renaming::in, tsubst::in,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
|
|
% sharing_as_rename_using_module_info(ModuleInfo, PPId,
|
|
% ActualVars, ActualTypes, CallerTVarset, CallerHeadVarParams,
|
|
% FormalSharing, ActualSharing):
|
|
%
|
|
% Renaming of the formal description of data structure sharing to the
|
|
% actual description of the sharing. The information about the formal
|
|
% variables needs to be extracted from the module information.
|
|
% A list of variables and types is used as the actual variables and types.
|
|
% The type variables set in the actual context must also be specified.
|
|
%
|
|
:- pred sharing_as_rename_using_module_info(module_info::in,
|
|
pred_proc_id::in, prog_vars::in, list(mer_type)::in, tvarset::in,
|
|
head_type_params::in, sharing_as::in, sharing_as::out) is det.
|
|
|
|
% One of the cornerstone operations of using the program analysis system
|
|
% is to provide a "comb" (combination) operation that combines new
|
|
% information with old information to obtain a new description. Within the
|
|
% analysis system, the "comb" operation is used to combine the information
|
|
% of a predicate call (the new information) to the information that is
|
|
% already available before the predicate call (the old information). The
|
|
% result must be a correct description of the execution state that would
|
|
% be obtained if the predicate call is executed in the circumstances
|
|
% described by the old information.
|
|
%
|
|
% comb is not commutative!
|
|
% The correct call is:
|
|
% Result = comb(ModuleInfo, ProcInfo, NewSharing, OldSharing).
|
|
%
|
|
:- func sharing_as_comb(module_info, proc_info, sharing_as, sharing_as)
|
|
= sharing_as.
|
|
|
|
% Add the sharing created by a unification to the already existing sharing
|
|
% information.
|
|
%
|
|
:- func add_unify_sharing(module_info, proc_info, unification, hlds_goal_info,
|
|
sharing_as) = sharing_as.
|
|
|
|
% Add the sharing created by a call to some foreign code. This
|
|
% sharing corresponds to the sharing information with which the
|
|
% foreign code was manually annotated, or can be predicted to
|
|
% "bottom", and in the worst case to "top".
|
|
%
|
|
:- pred add_foreign_proc_sharing(module_info::in, pred_info::in, proc_info::in,
|
|
pred_proc_id::in, pragma_foreign_proc_attributes::in,
|
|
list(foreign_arg)::in, prog_context::in, sharing_as::in, sharing_as::out)
|
|
is det.
|
|
|
|
% Compare two sharing sets. A sharing set Set1 is subsumed by a sharing set
|
|
% Set2 iff the total set of sharing represented by Set1 is a subset of the
|
|
% total set of sharing represented by Set2. This means that for every
|
|
% structure sharing pair in Set1, there exists a structure sharing pair P2
|
|
% in Set2, such that P1 is subsumed by P2 (i.e. P2 at least describes the
|
|
% same sharing as P1).
|
|
%
|
|
:- pred sharing_as_is_subsumed_by(module_info::in, proc_info::in,
|
|
sharing_as::in, sharing_as::in) is semidet.
|
|
|
|
:- pred sharing_as_and_status_is_subsumed_by(module_info::in, proc_info::in,
|
|
sharing_as_and_status::in, sharing_as_and_status::in) is semidet.
|
|
|
|
% Compute the least upper bound.
|
|
%
|
|
:- func sharing_as_least_upper_bound(module_info, proc_info,
|
|
sharing_as, sharing_as) = sharing_as.
|
|
:- func sharing_as_least_upper_bound_of_list(module_info, proc_info,
|
|
list(sharing_as)) = sharing_as.
|
|
|
|
% Compute the set of data structures whose memory representation coincide
|
|
% with the memory representation of the given datastructure.
|
|
% This corresponds to the "extend" operation used in Nancy's Phd.
|
|
% The operation produces a software error when called with a top alias
|
|
% description.
|
|
%
|
|
:- func extend_datastruct(module_info, proc_info, sharing_as, datastruct)
|
|
= list(datastruct).
|
|
:- func extend_datastructs(module_info, proc_info, sharing_as,
|
|
list(datastruct)) = list(datastruct).
|
|
|
|
% apply_widening(ModuleInfo, ProcInfo, WideningLimit, WideningDone,
|
|
% SharingIn, SharingOut):
|
|
%
|
|
% Perform type widening on the structure sharing information if the
|
|
% size of the set is larger than the indicated widening limit (unless the
|
|
% limit equals zero, in which case no widening is performed). The boolean
|
|
% WideningDone is set to true if indeed widening has been done.
|
|
%
|
|
% Type widening consists of mapping each selector within the
|
|
% structure sharing set to the type selector that designates the
|
|
% type of the node that is selected by that selector, which widens the
|
|
% information that is represented by the initial structure sharing
|
|
% description.
|
|
%
|
|
:- pred apply_widening(module_info::in, proc_info::in, int::in, bool::out,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
|
|
% Conversion between the public and the private representation for
|
|
% structure sharing sets.
|
|
%
|
|
:- func from_structure_sharing_domain(structure_sharing_domain) = sharing_as.
|
|
:- func to_structure_sharing_domain(sharing_as) = structure_sharing_domain.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% Sharing table
|
|
%
|
|
|
|
% This table is used to temporarily record the sharing analysis results,
|
|
% instead of saving in the HLDS and having to continuously convert between the
|
|
% public and private representation of structure sharing.
|
|
|
|
% Mapping between pred_proc_ids and sharing information that has been
|
|
% derived for the corresponding procedure definitions.
|
|
%
|
|
:- type sharing_as_table == map(pred_proc_id, sharing_as_and_status).
|
|
|
|
:- type sharing_as_and_status
|
|
---> sharing_as_and_status(
|
|
sharing_as,
|
|
analysis_status
|
|
).
|
|
|
|
% Initialisation.
|
|
%
|
|
:- func sharing_as_table_init = sharing_as_table.
|
|
|
|
% Look up the sharing information of a specific procedure. Fail if the
|
|
% procedure id is not in the map.
|
|
%
|
|
:- pred sharing_as_table_search(pred_proc_id::in, sharing_as_table::in,
|
|
sharing_as_and_status::out) is semidet.
|
|
|
|
% Set the sharing information for a given pred_proc_id.
|
|
%
|
|
:- pred sharing_as_table_set(pred_proc_id::in, sharing_as_and_status::in,
|
|
sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% Lookup the sharing information of a called procedure (given its
|
|
% pred_id and proc_id), and combine it with any existing
|
|
% sharing information.
|
|
%
|
|
:- pred lookup_sharing_and_comb(module_info::in, pred_info::in, proc_info::in,
|
|
sharing_as_table::in, pred_id::in, proc_id::in, prog_vars::in,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
|
|
% Lookup the sharing information in the sharing table, or if it is not
|
|
% in there, try to predict it using the information available in the
|
|
% module_info.
|
|
%
|
|
% Lookup the sharing information of a procedure identified by its
|
|
% pred_proc_id.
|
|
% 1 - look in sharing_as_table (as we might already have analysed
|
|
% the predicate, if defined in same module, or analysed in other
|
|
% imported module)
|
|
% 2 - try to predict bottom;
|
|
% 3 - react appropriately if the calls happen to be to
|
|
% * either compiler generated predicates
|
|
% * or predicates from builtin.m and private_builtin.m
|
|
% * :- external predicates
|
|
%
|
|
:- pred lookup_sharing_or_predict(module_info::in, sharing_as_table::in,
|
|
pred_proc_id::in, sharing_as::out, analysis_status::out, bool::out) is det.
|
|
|
|
% Succeeds if the sharing of a procedure can safely be approximated by
|
|
% "bottom", simply by looking at the modes and types of the arguments,
|
|
% or because the procedure is of a generated special predicate.
|
|
%
|
|
:- pred bottom_sharing_is_safe_approximation(module_info::in, pred_info::in,
|
|
proc_info::in) is semidet.
|
|
|
|
% Succeeds if the sharing of a call can safely be approximated by
|
|
% "bottom", simply by looking at the modes and types of the arguments.
|
|
%
|
|
:- pred bottom_sharing_is_safe_approximation_by_args(module_info::in,
|
|
list(mer_mode)::in, list(mer_type)::in) is semidet.
|
|
|
|
% Load all the structure sharing information present in the HLDS into
|
|
% a sharing table.
|
|
%
|
|
:- func load_structure_sharing_table(module_info) = sharing_as_table.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_match.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module hlds.hlds_llds.
|
|
:- import_module parse_tree.prog_ctgc.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module transform_hlds.ctgc.datastruct.
|
|
:- import_module transform_hlds.ctgc.selector.
|
|
:- import_module transform_hlds.ctgc.util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module exception.
|
|
:- import_module int.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module solutions.
|
|
:- import_module string.
|
|
:- import_module univ.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type sharing_as
|
|
---> sharing_as_real_as(sharing_set)
|
|
; sharing_as_bottom
|
|
; sharing_as_top(set(top_feedback)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
sharing_as_init = sharing_as_bottom.
|
|
|
|
sharing_as_is_bottom(sharing_as_bottom).
|
|
|
|
sharing_as_top_no_feedback = sharing_as_top(set.init).
|
|
|
|
sharing_as_top_sharing(Msg) = sharing_as_top(set.make_singleton_set(Msg)).
|
|
|
|
sharing_as_top_sharing_accumulate(Msg, SharingAs) = TopSharing :-
|
|
(
|
|
( SharingAs = sharing_as_real_as(_)
|
|
; SharingAs = sharing_as_bottom
|
|
),
|
|
TopSharing = sharing_as_top_sharing(Msg)
|
|
;
|
|
SharingAs = sharing_as_top(Msgs0),
|
|
Msgs = set.insert(Msgs0, Msg),
|
|
TopSharing = sharing_as_top(Msgs)
|
|
).
|
|
|
|
sharing_as_is_top(sharing_as_top(_)).
|
|
|
|
sharing_as_size(sharing_as_bottom) = 0.
|
|
sharing_as_size(sharing_as_real_as(SharingSet)) = sharing_set_size(SharingSet).
|
|
|
|
sharing_as_short_description(sharing_as_bottom) = "b".
|
|
sharing_as_short_description(sharing_as_top(_)) = "t".
|
|
sharing_as_short_description(sharing_as_real_as(SharingSet)) =
|
|
string.from_int(sharing_set_size(SharingSet)).
|
|
|
|
% inproject = projection such that result contains information about
|
|
% selection of variables only.
|
|
%
|
|
% outproject = projection such that result contains information about
|
|
% all variables _except_ the selection of variables.
|
|
%
|
|
:- type projection_type
|
|
---> inproject
|
|
; outproject.
|
|
|
|
sharing_as_project(ListVars, !SharingAs) :-
|
|
sharing_as_project_with_type(inproject, ListVars, !SharingAs).
|
|
sharing_as_project(ListVars, SharingAs) = NewSharingAs :-
|
|
sharing_as_project(ListVars, SharingAs, NewSharingAs).
|
|
|
|
:- pred sharing_as_project_with_type(projection_type::in, prog_vars::in,
|
|
sharing_as::in, sharing_as::out) is det.
|
|
|
|
sharing_as_project_with_type(ProjectionType, ListVars, !SharingAs) :-
|
|
(
|
|
!.SharingAs = sharing_as_bottom
|
|
;
|
|
!.SharingAs = sharing_as_real_as(SharingSet0),
|
|
sharing_set_project(ProjectionType, ListVars, SharingSet0, SharingSet),
|
|
!:SharingAs = wrap(SharingSet)
|
|
;
|
|
!.SharingAs = sharing_as_top(_)
|
|
).
|
|
|
|
sharing_as_project_set(SetVars, !SharingAs) :-
|
|
sharing_as_project(set.to_sorted_list(SetVars), !SharingAs).
|
|
|
|
sharing_as_rename(MapVar, TypeSubst, !SharingAs) :-
|
|
(
|
|
!.SharingAs = sharing_as_real_as(SharingSet0),
|
|
sharing_set_rename(MapVar, TypeSubst, SharingSet0, SharingSet),
|
|
!:SharingAs = sharing_as_real_as(SharingSet)
|
|
;
|
|
!.SharingAs = sharing_as_bottom
|
|
;
|
|
!.SharingAs = sharing_as_top(_)
|
|
).
|
|
|
|
sharing_as_rename_using_module_info(ModuleInfo, PPId, ActualVars, ActualTypes,
|
|
CallerTypeVarSet, CallerHeadTypeParams,
|
|
FormalSharing, ActualSharing) :-
|
|
VarRenaming = get_variable_renaming(ModuleInfo, PPId, ActualVars),
|
|
TypeSubst = get_type_substitution(ModuleInfo, PPId, ActualTypes,
|
|
CallerTypeVarSet, CallerHeadTypeParams),
|
|
sharing_as_rename(VarRenaming, TypeSubst, FormalSharing, ActualSharing).
|
|
|
|
sharing_as_comb(ModuleInfo, ProcInfo, NewSharing, OldSharing) = ResultSharing :-
|
|
(
|
|
NewSharing = sharing_as_real_as(NewSharingSet),
|
|
(
|
|
OldSharing = sharing_as_real_as(OldSharingSet),
|
|
promise_equivalent_solutions [MaybeExcp] (
|
|
try((pred(CombSet::out) is det :-
|
|
CombSet = sharing_set_comb(ModuleInfo, ProcInfo,
|
|
NewSharingSet, OldSharingSet)
|
|
), MaybeExcp)
|
|
),
|
|
(
|
|
MaybeExcp = succeeded(SharingSet),
|
|
ResultSharing = wrap(SharingSet)
|
|
;
|
|
MaybeExcp = exception(Excp),
|
|
( univ_to_type(Excp, encounter_existential_subtype) ->
|
|
Reason = top_cannot_improve("existential subtype"),
|
|
ResultSharing = sharing_as_top_sharing(Reason)
|
|
;
|
|
rethrow(MaybeExcp)
|
|
)
|
|
)
|
|
;
|
|
OldSharing = sharing_as_bottom,
|
|
ResultSharing = NewSharing
|
|
;
|
|
OldSharing = sharing_as_top(_),
|
|
ResultSharing = OldSharing
|
|
)
|
|
;
|
|
NewSharing = sharing_as_bottom,
|
|
ResultSharing = OldSharing
|
|
;
|
|
NewSharing = sharing_as_top(MsgNew),
|
|
( OldSharing = sharing_as_top(MsgOld) ->
|
|
ResultSharing = sharing_as_top(set.union(MsgNew, MsgOld))
|
|
;
|
|
ResultSharing = NewSharing
|
|
)
|
|
).
|
|
|
|
add_unify_sharing(ModuleInfo, ProcInfo, Unification, GoalInfo, OldSharing)
|
|
= NewSharing :-
|
|
UnifSharing = sharing_from_unification(ModuleInfo, ProcInfo, Unification,
|
|
GoalInfo),
|
|
ResultSharing = sharing_as_comb(ModuleInfo, ProcInfo,
|
|
UnifSharing, OldSharing),
|
|
%
|
|
% When the unification is a construction unification, some local variables
|
|
% may become totally useless for the rest of the code (deaths), and so any
|
|
% structure sharing involving these variables may safely be removed.
|
|
%
|
|
% NOTE: this "useless" sharing information can not be removed earlier as
|
|
% it can contribute to new sharing with the comb operation.
|
|
%
|
|
( Unification = construct(_, _, _, _, _, _, _) ->
|
|
NewSharing = optimization_remove_deaths(ProcInfo,
|
|
GoalInfo, ResultSharing)
|
|
;
|
|
NewSharing = ResultSharing
|
|
).
|
|
|
|
% Describe the sharing that is created between the variables involved in
|
|
% unification.
|
|
%
|
|
:- func sharing_from_unification(module_info, proc_info, unification,
|
|
hlds_goal_info) = sharing_as.
|
|
|
|
sharing_from_unification(ModuleInfo, ProcInfo, Unification, GoalInfo)
|
|
= Sharing :-
|
|
(
|
|
Unification = construct(Var, ConsId, Args0, _, _, _, _),
|
|
( var_needs_sharing_analysis(ModuleInfo, ProcInfo, Var) ->
|
|
list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
|
|
_TypeInfoArgs, Args),
|
|
number_args(Args, NumberedArgs),
|
|
some [!SharingSet] (
|
|
!:SharingSet = sharing_set_init,
|
|
list.foldl(
|
|
add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
|
|
NumberedArgs, !SharingSet),
|
|
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId,
|
|
NumberedArgs, !SharingSet),
|
|
Sharing = wrap(!.SharingSet)
|
|
)
|
|
;
|
|
Sharing = sharing_as_init
|
|
)
|
|
;
|
|
Unification = deconstruct(Var, ConsId, Args0, _, _, _),
|
|
list.takewhile(is_introduced_typeinfo_arg(ProcInfo), Args0,
|
|
_TypeInfoArgs, Args),
|
|
number_args(Args, NumberedArgs),
|
|
optimize_for_deconstruct(GoalInfo, NumberedArgs, ReducedNumberedArgs),
|
|
some [!SharingSet] (
|
|
!:SharingSet = sharing_set_init,
|
|
list.foldl(add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId),
|
|
ReducedNumberedArgs, !SharingSet),
|
|
Sharing = wrap(!.SharingSet)
|
|
)
|
|
;
|
|
Unification = assign(X, Y),
|
|
( var_needs_sharing_analysis(ModuleInfo, ProcInfo, X) ->
|
|
new_entry(ModuleInfo, ProcInfo,
|
|
datastruct_init(X) - datastruct_init(Y),
|
|
sharing_set_init, SharingSet),
|
|
Sharing = wrap(SharingSet)
|
|
;
|
|
Sharing = sharing_as_init
|
|
)
|
|
;
|
|
Unification = simple_test(_, _),
|
|
Sharing = sharing_as_init
|
|
;
|
|
Unification = complicated_unify(_, _, _),
|
|
unexpected($module, $pred, "complicated_unify")
|
|
).
|
|
|
|
:- pred is_introduced_typeinfo_arg(proc_info::in, prog_var::in) is semidet.
|
|
|
|
is_introduced_typeinfo_arg(ProcInfo, Var) :-
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_type(VarTypes, Var, Type),
|
|
is_introduced_type_info_type(Type).
|
|
|
|
:- pred number_args(prog_vars::in, list(pair(int, prog_var))::out) is det.
|
|
|
|
number_args(Args, NumberedArgs) :-
|
|
NumberArg = (pred(A::in, AP::out, !.N::in, !:N::out) is det :-
|
|
AP = !.N - A,
|
|
!:N = !.N + 1
|
|
),
|
|
list.map_foldl(NumberArg, Args, NumberedArgs, 1, _).
|
|
|
|
:- pred add_var_arg_sharing(module_info::in, proc_info::in, prog_var::in,
|
|
cons_id::in, pair(int, prog_var)::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
add_var_arg_sharing(ModuleInfo, ProcInfo, Var, ConsId, N - Arg, !Sharing) :-
|
|
( var_needs_sharing_analysis(ModuleInfo, ProcInfo, Arg) ->
|
|
Data1 = datastruct_init_with_pos(Var, ConsId, N),
|
|
Data2 = datastruct_init(Arg),
|
|
new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
|
|
;
|
|
true
|
|
).
|
|
|
|
% When two positions within the constructed term refer to the same variable,
|
|
% this must be recorded as an extra sharing pair.
|
|
% E.g.: X = f(Y,Y), then the sharing between f/1 and f/2 must be recorded.
|
|
% XXX Different implementation!
|
|
%
|
|
:- pred create_internal_sharing(module_info::in, proc_info::in,
|
|
prog_var::in, cons_id::in, list(pair(int, prog_var))::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId, NumberedArgs,
|
|
!Sharing) :-
|
|
% For every argument and the occurrence of the variable of that argument
|
|
% in the rest of the arguments, add the appropriate sharing pair.
|
|
(
|
|
NumberedArgs = [First | Remainder],
|
|
First = Pos1 - Var1,
|
|
AddPair = (pred(OtherNumberedArg::in,
|
|
!.Sharing::in, !:Sharing::out) is det :-
|
|
( OtherNumberedArg = Pos2 - Var1 ->
|
|
% Create sharing between Pos1 and Pos2
|
|
Data1 = datastruct_init_with_pos(Var, ConsId, Pos1),
|
|
Data2 = datastruct_init_with_pos(Var, ConsId, Pos2),
|
|
new_entry(ModuleInfo, ProcInfo, Data1 - Data2, !Sharing)
|
|
;
|
|
true
|
|
)
|
|
),
|
|
list.foldl(AddPair, Remainder, !Sharing),
|
|
create_internal_sharing(ModuleInfo, ProcInfo, Var, ConsId, Remainder,
|
|
!Sharing)
|
|
;
|
|
NumberedArgs = []
|
|
).
|
|
|
|
% For deconstructions, a huge optimization can be made by avoiding the
|
|
% construction of sharing between variables that are not used in the
|
|
% remainder of the code anyway. The set of used args is known as the
|
|
% pre-birth set as computed by the liveness-pass (liveness.m).
|
|
%
|
|
% XXX Why was the original implementation so complicated?
|
|
%
|
|
:- pred optimize_for_deconstruct(hlds_goal_info::in,
|
|
list(pair(int, prog_var))::in, list(pair(int, prog_var))::out) is det.
|
|
|
|
optimize_for_deconstruct(GoalInfo, !NumberedArgs) :-
|
|
hlds_llds.goal_info_get_pre_births(GoalInfo, PreBirthSet),
|
|
IsPreBirthArg = (pred(NumberedArg::in) is semidet :-
|
|
Var = snd(NumberedArg),
|
|
set_of_var.member(PreBirthSet, Var)
|
|
),
|
|
list.filter(IsPreBirthArg, !NumberedArgs).
|
|
|
|
:- func optimization_remove_deaths(proc_info, hlds_goal_info,
|
|
sharing_as) = sharing_as.
|
|
|
|
optimization_remove_deaths(ProcInfo, GoalInfo, Sharing0) = Sharing :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
HeadVarsSet = set_of_var.list_to_set(HeadVars),
|
|
goal_info_get_post_deaths(GoalInfo, Deaths0),
|
|
|
|
% Make sure to keep all the information about the headvars,
|
|
% even if they are in the post deaths set.
|
|
set_of_var.difference(Deaths0, HeadVarsSet, Deaths),
|
|
DeathsList = set_of_var.to_sorted_list(Deaths),
|
|
sharing_as_project_with_type(outproject, DeathsList, Sharing0, Sharing).
|
|
|
|
add_foreign_proc_sharing(ModuleInfo, PredInfo, ProcInfo, ForeignPPId,
|
|
Attributes, Args, GoalContext, OldSharing, NewSharing) :-
|
|
ForeignSharing = sharing_as_for_foreign_proc(ModuleInfo,
|
|
Attributes, ForeignPPId, GoalContext),
|
|
|
|
ActualVars = list.map(foreign_arg_var, Args),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_types(VarTypes, ActualVars, ActualTypes),
|
|
pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
|
|
pred_info_get_head_type_params(PredInfo, CallerHeadTypeParams),
|
|
|
|
sharing_as_rename_using_module_info(ModuleInfo, ForeignPPId,
|
|
ActualVars, ActualTypes, CallerTypeVarSet,
|
|
CallerHeadTypeParams, ForeignSharing, ActualSharing),
|
|
|
|
NewSharing = sharing_as_comb(ModuleInfo, ProcInfo, ActualSharing,
|
|
OldSharing).
|
|
|
|
:- func sharing_as_for_foreign_proc(module_info,
|
|
pragma_foreign_proc_attributes, pred_proc_id, prog_context) = sharing_as.
|
|
|
|
sharing_as_for_foreign_proc(ModuleInfo, Attributes, ForeignPPId,
|
|
ProgContext) = SharingAs :-
|
|
(
|
|
sharing_as_from_user_annotated_sharing(Attributes, SharingAs0)
|
|
->
|
|
SharingAs = SharingAs0
|
|
;
|
|
predict_called_pred_is_bottom(ModuleInfo, ForeignPPId)
|
|
->
|
|
SharingAs = sharing_as_bottom
|
|
;
|
|
context_to_string(ProgContext, ContextString),
|
|
Msg = "foreign proc with unknown sharing ("
|
|
++ ContextString ++ ")",
|
|
SharingAs = sharing_as_top_sharing(top_cannot_improve(Msg))
|
|
).
|
|
|
|
:- pred sharing_as_from_user_annotated_sharing(
|
|
pragma_foreign_proc_attributes::in, sharing_as::out) is semidet.
|
|
|
|
sharing_as_from_user_annotated_sharing(Attributes, UserSharingAs) :-
|
|
UserSharing = get_user_annotated_sharing(Attributes),
|
|
UserSharing = user_sharing(SharingDomain, _MaybeTypes),
|
|
% Accept only the value "bottom" and "real" for the structure sharing.
|
|
% If the user has annotated the sharing with unknown sharing, we might
|
|
% try to predict bottom anyway.
|
|
some [!SharingAs] (
|
|
(
|
|
SharingDomain = structure_sharing_bottom,
|
|
!:SharingAs = sharing_as_bottom
|
|
;
|
|
SharingDomain = structure_sharing_real(_SharingPairs),
|
|
!:SharingAs = from_structure_sharing_domain(SharingDomain)
|
|
|
|
% XXX
|
|
% I have the feeling that renaming should not be needed at this
|
|
% place anymore, assuming that every foreign_proc call is
|
|
% correctly handled at the add_pragma stage?
|
|
),
|
|
UserSharingAs = !.SharingAs
|
|
).
|
|
|
|
sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2) :-
|
|
(
|
|
Sharing2 = sharing_as_top(_)
|
|
;
|
|
Sharing1 = sharing_as_bottom
|
|
;
|
|
Sharing1 = sharing_as_real_as(SharingSet1),
|
|
Sharing2 = sharing_as_real_as(SharingSet2),
|
|
sharing_set_is_subsumed_by(ModuleInfo, ProcInfo, SharingSet1,
|
|
SharingSet2)
|
|
).
|
|
|
|
sharing_as_and_status_is_subsumed_by(ModuleInfo, ProcInfo,
|
|
SharingAs_Status1, SharingAs_Status2) :-
|
|
SharingAs_Status1 = sharing_as_and_status(Sharing1, _Status1),
|
|
SharingAs_Status2 = sharing_as_and_status(Sharing2, _Status2),
|
|
sharing_as_is_subsumed_by(ModuleInfo, ProcInfo, Sharing1, Sharing2).
|
|
% XXX do we need to compare Status1 and Status2?
|
|
|
|
sharing_as_least_upper_bound(ModuleInfo, ProcInfo, Sharing1, Sharing2)
|
|
= Sharing :-
|
|
(
|
|
Sharing1 = sharing_as_bottom,
|
|
Sharing = Sharing2
|
|
;
|
|
Sharing1 = sharing_as_top(Msg1),
|
|
( Sharing2 = sharing_as_top(Msg2) ->
|
|
Sharing = sharing_as_top(set.union(Msg1, Msg2))
|
|
;
|
|
Sharing = Sharing1
|
|
)
|
|
;
|
|
Sharing1 = sharing_as_real_as(SharingSet1),
|
|
(
|
|
Sharing2 = sharing_as_bottom,
|
|
Sharing = Sharing1
|
|
;
|
|
Sharing2 = sharing_as_top(_),
|
|
Sharing = Sharing2
|
|
;
|
|
Sharing2 = sharing_as_real_as(SharingSet2),
|
|
promise_equivalent_solutions [MaybeExcp] (
|
|
try((pred(SharingSet3::out) is det :-
|
|
SharingSet3 = sharing_set_least_upper_bound(ModuleInfo,
|
|
ProcInfo, SharingSet1, SharingSet2)
|
|
), MaybeExcp)
|
|
),
|
|
(
|
|
MaybeExcp = succeeded(SharingSet),
|
|
Sharing = sharing_as_real_as(SharingSet)
|
|
;
|
|
MaybeExcp = exception(Excp),
|
|
( univ_to_type(Excp, encounter_existential_subtype) ->
|
|
Reason = top_cannot_improve("existential subtype"),
|
|
Sharing = sharing_as_top_sharing(Reason)
|
|
;
|
|
rethrow(MaybeExcp)
|
|
)
|
|
)
|
|
)
|
|
).
|
|
|
|
sharing_as_least_upper_bound_of_list(ModuleInfo, ProcInfo, SharingList) =
|
|
list.foldl(sharing_as_least_upper_bound(ModuleInfo, ProcInfo), SharingList,
|
|
sharing_as_init).
|
|
|
|
extend_datastruct(ModuleInfo, ProcInfo, SharingAs, Datastruct)
|
|
= Datastructures :-
|
|
(
|
|
SharingAs = sharing_as_bottom,
|
|
Datastructures = [Datastruct]
|
|
;
|
|
SharingAs = sharing_as_real_as(SharingSet),
|
|
Datastructures = sharing_set_extend_datastruct(ModuleInfo, ProcInfo,
|
|
Datastruct, SharingSet)
|
|
;
|
|
SharingAs = sharing_as_top(_),
|
|
unexpected($module, $pred, "top sharing set")
|
|
).
|
|
|
|
extend_datastructs(ModuleInfo, ProcInfo, SharingAs, Datastructs)
|
|
= ExtendedDatastructs :-
|
|
DataLists = list.map(extend_datastruct(ModuleInfo, ProcInfo,
|
|
SharingAs), Datastructs),
|
|
ExtendedDatastructs = list.foldl(
|
|
datastruct_lists_least_upper_bound(ModuleInfo, ProcInfo),
|
|
DataLists, []).
|
|
|
|
apply_widening(ModuleInfo, ProcInfo, WideningLimit, WideningDone, !Sharing):-
|
|
(
|
|
!.Sharing = sharing_as_bottom,
|
|
WideningDone = no
|
|
;
|
|
!.Sharing = sharing_as_top(_),
|
|
WideningDone = no
|
|
;
|
|
!.Sharing = sharing_as_real_as(SharingSet0),
|
|
( WideningLimit = 0 ->
|
|
WideningDone = no
|
|
; WideningLimit > sharing_set_size(SharingSet0) ->
|
|
WideningDone = no
|
|
;
|
|
sharing_set_apply_widening(ModuleInfo, ProcInfo,
|
|
SharingSet0, SharingSet),
|
|
!:Sharing = sharing_as_real_as(SharingSet),
|
|
WideningDone = yes
|
|
)
|
|
).
|
|
|
|
from_structure_sharing_domain(SharingDomain) = SharingAs :-
|
|
(
|
|
SharingDomain = structure_sharing_bottom,
|
|
SharingAs = sharing_as_bottom
|
|
;
|
|
SharingDomain = structure_sharing_real(StructureSharing),
|
|
SharingSet = from_sharing_pair_list(StructureSharing),
|
|
wrap(SharingSet, SharingAs)
|
|
;
|
|
SharingDomain = structure_sharing_top(Reasons),
|
|
SharingAs = sharing_as_top(Reasons)
|
|
).
|
|
|
|
to_structure_sharing_domain(SharingAs) = SharingDomain :-
|
|
(
|
|
SharingAs = sharing_as_bottom,
|
|
SharingDomain = structure_sharing_bottom
|
|
;
|
|
SharingAs = sharing_as_real_as(SharingSet),
|
|
SharingDomain = structure_sharing_real(
|
|
to_sharing_pair_list(SharingSet))
|
|
;
|
|
SharingAs = sharing_as_top(Msgs),
|
|
SharingDomain = structure_sharing_top(Msgs)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% sharing_as_table
|
|
%
|
|
|
|
sharing_as_table_init = map.init.
|
|
|
|
sharing_as_table_search(PPId, Table, SharingAs_Status) :-
|
|
map.search(Table, PPId, SharingAs_Status).
|
|
|
|
sharing_as_table_set(PPId, SharingAs_Status, !Table) :-
|
|
!Table ^ elem(PPId) := SharingAs_Status.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
lookup_sharing_and_comb(ModuleInfo, PredInfo, ProcInfo, SharingTable,
|
|
PredId, ProcId, ActualVars, !Sharing):-
|
|
PPId = proc(PredId, ProcId),
|
|
|
|
% XXX do we need to combine the analysis status of sharing information we
|
|
% use with the analysis status of direct and indirect analyses?
|
|
lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, FormalSharing,
|
|
_Status, _IsPredicted),
|
|
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_types(VarTypes, ActualVars, ActualTypes),
|
|
|
|
pred_info_get_typevarset(PredInfo, CallerTypeVarSet),
|
|
pred_info_get_univ_quant_tvars(PredInfo, CallerHeadTypeParams),
|
|
sharing_as_rename_using_module_info(ModuleInfo, PPId,
|
|
ActualVars, ActualTypes, CallerTypeVarSet, CallerHeadTypeParams,
|
|
FormalSharing, ActualSharing),
|
|
|
|
!:Sharing = sharing_as_comb(ModuleInfo, ProcInfo,
|
|
ActualSharing, !.Sharing).
|
|
|
|
lookup_sharing_or_predict(ModuleInfo, SharingTable, PPId, SharingAs, Status,
|
|
IsPredicted) :-
|
|
(
|
|
% look up in SharingTable
|
|
sharing_as_table_search(PPId, SharingTable,
|
|
sharing_as_and_status(SharingAs0, Status0))
|
|
->
|
|
SharingAs = SharingAs0,
|
|
Status = Status0,
|
|
IsPredicted = no
|
|
;
|
|
% or predict bottom sharing
|
|
%
|
|
% If it is neither in the fixpoint table, nor in the sharing
|
|
% table, then this means that we have never analysed the called
|
|
% procedure, yet in some cases we can still simply predict that
|
|
% the sharing the called procedure creates is bottom.
|
|
predict_called_pred_is_bottom(ModuleInfo, PPId)
|
|
->
|
|
SharingAs = sharing_as_init,
|
|
Status = optimal,
|
|
IsPredicted = yes
|
|
;
|
|
PPId = proc(PredId, _),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_import_status(PredInfo, ImportStatus),
|
|
ImportStatus = status_external(_)
|
|
->
|
|
SharingAs = sharing_as_top_sharing(top_cannot_improve(
|
|
"external predicate")),
|
|
Status = optimal,
|
|
IsPredicted = no
|
|
;
|
|
% or use top-sharing with appropriate message.
|
|
SharingAs = top_sharing_not_found(PPId),
|
|
Status = optimal,
|
|
IsPredicted = no
|
|
).
|
|
|
|
:- pred predict_called_pred_is_bottom(module_info::in, pred_proc_id::in)
|
|
is semidet.
|
|
|
|
predict_called_pred_is_bottom(ModuleInfo, PPId) :-
|
|
module_info_pred_proc_info(ModuleInfo, PPId, PredInfo, ProcInfo),
|
|
(
|
|
% 1. inferred determinism is erroneous/failure.
|
|
proc_info_get_inferred_determinism(ProcInfo, Determinism),
|
|
(
|
|
Determinism = detism_erroneous
|
|
;
|
|
Determinism = detism_failure
|
|
)
|
|
;
|
|
% 2. bottom_sharing_is_safe_approximation
|
|
bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo, ProcInfo)
|
|
;
|
|
% 3. call to a compiler generate special predicate:
|
|
% "unify", "index", "compare" or "initialise".
|
|
pred_info_get_origin(PredInfo, Origin),
|
|
Origin = origin_special_pred(_)
|
|
).
|
|
|
|
:- func top_sharing_not_found(pred_proc_id) = sharing_as.
|
|
|
|
top_sharing_not_found(PPId) = TopSharing :-
|
|
ShroudedPredProcId = shroud_pred_proc_id(PPId),
|
|
Reason = top_failed_lookup(ShroudedPredProcId),
|
|
TopSharing = sharing_as_top_sharing(Reason).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
load_structure_sharing_table(ModuleInfo) = SharingTable :-
|
|
module_info_get_valid_predids(PredIds, ModuleInfo, _ModuleInfo),
|
|
list.foldl(load_structure_sharing_table_2(ModuleInfo), PredIds,
|
|
sharing_as_table_init, SharingTable).
|
|
|
|
:- pred load_structure_sharing_table_2(module_info::in, pred_id::in,
|
|
sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
load_structure_sharing_table_2(ModuleInfo, PredId, !SharingTable) :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
ProcIds = pred_info_procids(PredInfo),
|
|
list.foldl(load_structure_sharing_table_3(ModuleInfo, PredId),
|
|
ProcIds, !SharingTable).
|
|
|
|
:- pred load_structure_sharing_table_3(module_info::in, pred_id::in,
|
|
proc_id::in, sharing_as_table::in, sharing_as_table::out) is det.
|
|
|
|
load_structure_sharing_table_3(ModuleInfo, PredId, ProcId, !SharingTable) :-
|
|
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
|
|
proc_info_get_structure_sharing(ProcInfo, MaybePublicSharing),
|
|
(
|
|
MaybePublicSharing = yes(
|
|
structure_sharing_domain_and_status(PublicSharing, Status)),
|
|
PPId = proc(PredId, ProcId),
|
|
PrivateSharing = from_structure_sharing_domain(PublicSharing),
|
|
sharing_as_table_set(PPId,
|
|
sharing_as_and_status(PrivateSharing, Status), !SharingTable)
|
|
;
|
|
MaybePublicSharing = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
bottom_sharing_is_safe_approximation(ModuleInfo, PredInfo, ProcInfo) :-
|
|
(
|
|
% Generated special predicates don't introduce sharing.
|
|
pred_info_get_origin(PredInfo, Origin),
|
|
Origin = origin_special_pred(_)
|
|
;
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_get_argmodes(ProcInfo, Modes),
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_types(VarTypes, HeadVars, Types),
|
|
bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes, Types)
|
|
).
|
|
|
|
bottom_sharing_is_safe_approximation_by_args(ModuleInfo, Modes, Types) :-
|
|
ModeTypePairs = assoc_list.from_corresponding_lists(Modes, Types),
|
|
Test = (pred(Pair::in) is semidet :-
|
|
Pair = Mode - Type,
|
|
|
|
% Mode is not unique nor clobbered.
|
|
mode_get_insts(ModuleInfo, Mode, _LeftInst, RightInst),
|
|
\+ inst_is_unique(ModuleInfo, RightInst),
|
|
\+ inst_is_clobbered(ModuleInfo, RightInst),
|
|
|
|
% Mode is output.
|
|
mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
|
|
ArgMode = top_out,
|
|
|
|
% Type is one which we care about for structure sharing/reuse.
|
|
type_needs_sharing_analysis(ModuleInfo, Type)
|
|
),
|
|
list.filter(Test, ModeTypePairs, TrueModeTypePairs),
|
|
TrueModeTypePairs = [].
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
% Type: sharing_set.
|
|
% Definition of the (hidden) representation for lists of sharing data
|
|
% structures.
|
|
% XXX The definition and implementation of sharing_set should be in a separate
|
|
% (sub)module. Yet this gave compilation errors. To do.
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
% Theoretically, a structure sharing set is a set of structure sharing
|
|
% pairs, i.e., pairs of data structures reflecting the possible sharing between
|
|
% them. However, lookup operations occur often, and have a dramatic performance
|
|
% using this simple representation. We therefore use a hierarchy of different
|
|
% map-types to represent a structure sharing set.
|
|
%
|
|
% Hence: In the sharing_set we map a prog_var to a description of the
|
|
% structure sharing pairs it is involved in. These structure sharing pairs
|
|
% are represented as a map mapping selectors on data structure sets.
|
|
% Suppose (Sel-Data) is in the map to which prog_var V relates to, then this
|
|
% means that the memory space for V ^ Sel might share with the memory spaces
|
|
% used for each of the data structures in Data.
|
|
% Note that in the sharing_set type we explicitly keep track of the number of
|
|
% structure sharing pairs at each level of the map.
|
|
%
|
|
% Example:
|
|
% A set of one sharing pair expressing that the memory space
|
|
% for the term of a variable X might be the same as the memory space used
|
|
% to store the term of a variable Y:
|
|
% * Plain representation would be: { (X^\epsilon - Y^\epsilon) } -- where
|
|
% \epsilon stands for the empty selector in this formulation.
|
|
% * Optimised representation:
|
|
% sharing_set(
|
|
% 2, % number of structure sharing pairs in the
|
|
% % sharing set. If X-Y is sharing, then also
|
|
% % Y-X, hence in this case "2".
|
|
% {
|
|
% X -> selector_sharing_set(
|
|
% 1, % number of data structures with
|
|
% % which terms of X share in this set.
|
|
% { \epsilon -> Y^\epsilon }
|
|
% )
|
|
% Y -> selector_sharing_set(
|
|
% 1,
|
|
% { \epsilon -> X^\epsilon }
|
|
% )
|
|
% }
|
|
% )
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
|
|
:- type sharing_set
|
|
---> sharing_set(
|
|
int, % number of structure sharing pairs represented
|
|
% by the set.
|
|
map(prog_var, selector_sharing_set)
|
|
).
|
|
|
|
:- type selector_sharing_set
|
|
---> selector_sharing_set(
|
|
int, % number of data structures represented by this
|
|
% set.
|
|
map(selector, data_set)
|
|
).
|
|
|
|
:- type data_set
|
|
---> datastructures(
|
|
int, % size of the set of data structures.
|
|
set(datastruct)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% sharing_set predicates/functions
|
|
%
|
|
|
|
:- func sharing_set_init = sharing_set is det.
|
|
:- pred sharing_set_is_empty(sharing_set::in) is semidet.
|
|
:- func sharing_set_size(sharing_set) = int.
|
|
|
|
:- pred wrap(sharing_set::in, sharing_as::out) is det.
|
|
:- func wrap(sharing_set) = sharing_as.
|
|
|
|
:- pred sharing_set_project(projection_type::in, prog_vars::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
:- pred sharing_set_rename(prog_var_renaming::in, tsubst::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
:- func sharing_set_comb(module_info, proc_info, sharing_set, sharing_set) =
|
|
sharing_set.
|
|
|
|
:- pred sharing_set_is_subsumed_by(module_info::in, proc_info::in,
|
|
sharing_set::in, sharing_set::in) is semidet.
|
|
|
|
:- func sharing_set_least_upper_bound(module_info, proc_info,
|
|
sharing_set, sharing_set) = sharing_set.
|
|
|
|
:- func sharing_set_extend_datastruct(module_info, proc_info, datastruct,
|
|
sharing_set) = list(datastruct).
|
|
|
|
:- pred sharing_set_apply_widening(module_info::in, proc_info::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
% Conversion between list of sharing data structures to
|
|
% sharing_set's and vice versa.
|
|
%
|
|
% NOTE: from_sharing_pair_list assumes that the sharing set is minimal, ie,
|
|
% there are no two sharing pairs in that set such that one sharing pair
|
|
% subsumes the other pair.
|
|
%
|
|
:- func from_sharing_pair_list(structure_sharing) = sharing_set.
|
|
:- func to_sharing_pair_list(sharing_set) = structure_sharing.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
sharing_set_init = sharing_set(0, map.init).
|
|
sharing_set_is_empty(sharing_set(0, _Map)).
|
|
sharing_set_size(sharing_set(Size, _)) = Size.
|
|
|
|
wrap(SharingSet, SharingAs) :-
|
|
( sharing_set_is_empty(SharingSet) ->
|
|
SharingAs = sharing_as_bottom
|
|
;
|
|
SharingAs = sharing_as_real_as(SharingSet)
|
|
).
|
|
|
|
wrap(SharingSet) = SharingAs :-
|
|
wrap(SharingSet, SharingAs).
|
|
|
|
sharing_set_project(ProjectionType, Vars, SharingSet0, SharingSet) :-
|
|
SharingSet0 = sharing_set(_, Map0),
|
|
(
|
|
ProjectionType = inproject,
|
|
map.select(Map0, set.list_to_set(Vars), Map)
|
|
;
|
|
ProjectionType = outproject,
|
|
map.keys(Map0, AllVars),
|
|
set.difference(set.list_to_set(AllVars), set.list_to_set(Vars),
|
|
Remainder),
|
|
map.select(Map0, Remainder, Map)
|
|
),
|
|
map.foldl(project_and_update_sharing_set(ProjectionType, Vars),
|
|
Map, sharing_set_init, SharingSet).
|
|
|
|
:- pred project_and_update_sharing_set(projection_type::in, prog_vars::in,
|
|
prog_var::in, selector_sharing_set::in, sharing_set::in, sharing_set::out)
|
|
is det.
|
|
|
|
project_and_update_sharing_set(ProjectionType, Vars, Var, SelSet0, !SS) :-
|
|
selector_sharing_set_project(ProjectionType, Vars, SelSet0, SelSet),
|
|
( selector_sharing_set_is_empty(SelSet) ->
|
|
true
|
|
;
|
|
!.SS = sharing_set(Size0, M0),
|
|
map.det_insert(Var, SelSet, M0, M),
|
|
Size = Size0 + selector_sharing_set_size(SelSet),
|
|
!:SS = sharing_set(Size, M)
|
|
).
|
|
|
|
sharing_set_rename(Dict, TypeSubst, SharingSet0, SharingSet) :-
|
|
SharingSet0 = sharing_set(Size, Map0),
|
|
map.foldl(do_sharing_set_rename(Dict, TypeSubst), Map0, map.init, Map),
|
|
SharingSet = sharing_set(Size, Map).
|
|
|
|
:- pred do_sharing_set_rename(prog_var_renaming::in, tsubst::in,
|
|
prog_var::in, selector_sharing_set::in,
|
|
map(prog_var, selector_sharing_set)::in,
|
|
map(prog_var, selector_sharing_set)::out) is det.
|
|
|
|
do_sharing_set_rename(Dict, TypeSubst, Var0, SelectorSet0, !Map) :-
|
|
selector_sharing_set_rename(Dict, TypeSubst, SelectorSet0, SelectorSet1),
|
|
map.lookup(Dict, Var0, Var),
|
|
% Two variables can be renamed to the same new variable,
|
|
% e.g. append(X, X, Y).
|
|
( map.search(!.Map, Var, SelectorSet2) ->
|
|
selector_sharing_set_add(SelectorSet1, SelectorSet2, SelectorSet),
|
|
map.det_update(Var, SelectorSet, !Map)
|
|
;
|
|
map.det_insert(Var, SelectorSet1, !Map)
|
|
).
|
|
|
|
% The implementation for combining sharing sets is to compute the
|
|
% alternating closure of those sets.
|
|
% Adapted copy/paste of the definition as given in Phd Nancy (definition
|
|
% 6.31):
|
|
% Let X, Y be sets of pairs of elements of any kind, then
|
|
% altclos(X, Y) = { (a_0, a_n) |
|
|
% a sequence (a_0, a_1).(a_1, a_2). ... .(a_(n_1),a_n) can be constructed
|
|
% where adjoining pairs stem from either X or Y, i.e., if (a_i, a_(i+1))
|
|
% \in X, then (a_(i+1), a_(i+2)) \from Y.
|
|
%
|
|
% Although the theoretic definition is commutative, the implementation uses
|
|
% some of the known properties of existings sharing and additional sharing,
|
|
% which simplifies the implementation, yet makes it non-commutative.
|
|
% Instead of computing needless chains of sharing pairs, the alternating
|
|
% closure of a NewSharingSet, and an OldSharingSet, is equivalent to the
|
|
% least upper bound of the sets (Corollary 10.1):
|
|
% * NewSharingSet
|
|
% * OldSharingSet
|
|
% * sharing pairs formed using paths of length two (direction irrelevant)
|
|
% * sharing pairs formed using paths of length three N - O - N, where
|
|
% N are sharing pairs from NewSharingSet, and O is a sharing pair from
|
|
% OldSharingSet.
|
|
%
|
|
sharing_set_comb(ModuleInfo, ProcInfo, NewSharingSet, OldSharingSet)
|
|
= ResultSharingSet :-
|
|
|
|
% paths of length 2:
|
|
OldNewSharingSet = sharing_set_altclos_2(ModuleInfo, ProcInfo,
|
|
NewSharingSet, OldSharingSet),
|
|
|
|
% paths of length 3:
|
|
NewOldNewSharingSet = sharing_set_altclos_3_directed(ModuleInfo, ProcInfo,
|
|
NewSharingSet, OldSharingSet),
|
|
|
|
% combine it all:
|
|
ResultSharingSet = sharing_set_least_upper_bound_list(ModuleInfo, ProcInfo,
|
|
[NewSharingSet, OldSharingSet, OldNewSharingSet], NewOldNewSharingSet).
|
|
|
|
% XXX new implementation.
|
|
%
|
|
:- func sharing_set_altclos_2(module_info, proc_info, sharing_set,
|
|
sharing_set) = sharing_set.
|
|
|
|
sharing_set_altclos_2(ModuleInfo, ProcInfo, NewSharingSet, OldSharingSet)
|
|
= ResultSharingSet :-
|
|
|
|
NewSharingSet = sharing_set(_, NewMap),
|
|
OldSharingSet = sharing_set(_, OldMap),
|
|
|
|
% compute common vars:
|
|
map.keys(NewMap, NewVars),
|
|
map.keys(OldMap, OldVars),
|
|
set.list_to_set(NewVars, NewVarsSet),
|
|
set.list_to_set(OldVars, OldVarsSet),
|
|
set.intersect(NewVarsSet, OldVarsSet, CommonVarsSet),
|
|
set.to_sorted_list(CommonVarsSet, CommonVars),
|
|
|
|
% downsize the maps to contain only the keys regarding the common vars:
|
|
% XXX Is this really an optimisation?
|
|
map.select(NewMap, CommonVarsSet, NewMap1),
|
|
map.select(OldMap, CommonVarsSet, OldMap1),
|
|
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
%
|
|
% for each common var V, compute the sharing pairs A-B, such that
|
|
% \exists X where var(X) = V, and X-A \in NewSharingSet, and X-B \in
|
|
% OldSharingSet.
|
|
%
|
|
list.foldl(
|
|
(pred(Var::in, !.SS::in, !:SS::out) is det :-
|
|
lookup_var_type(VarTypes, Var, Type),
|
|
map.lookup(NewMap1, Var, NewSelSet),
|
|
map.lookup(OldMap1, Var, OldSelSet),
|
|
SharingPairs = selector_sharing_set_altclos(ModuleInfo, ProcInfo,
|
|
Type, NewSelSet, OldSelSet),
|
|
new_entries(ModuleInfo, ProcInfo, SharingPairs, !SS)
|
|
), CommonVars, sharing_set_init, ResultSharingSet).
|
|
|
|
% sharing_set_altclos_3_directed(ModuleInfo, ProcInfo, NewSharingSet,
|
|
% OldSharingSet) =
|
|
% Compute the sharing pairs A-B such that exists X-Y \in OldSharingSet and
|
|
% A - X \subsumed by NewSharingSet,
|
|
% Y - B \subsumed by NewSharingSet.
|
|
% XXX New implementation.
|
|
%
|
|
:- func sharing_set_altclos_3_directed(module_info, proc_info,
|
|
sharing_set, sharing_set) = sharing_set.
|
|
|
|
sharing_set_altclos_3_directed(ModuleInfo, ProcInfo,
|
|
NewSharingSet, OldSharingSet) = ResultSharingSet :-
|
|
|
|
NewSharingSet = sharing_set(_, NewMap),
|
|
OldSharingSet = sharing_set(_, OldMap),
|
|
|
|
% compute common vars:
|
|
map.keys(NewMap, NewVars),
|
|
map.keys(OldMap, OldVars),
|
|
set.list_to_set(NewVars, NewVarsSet),
|
|
set.list_to_set(OldVars, OldVarsSet),
|
|
set.intersect(NewVarsSet, OldVarsSet, CommonVarsSet),
|
|
set.to_sorted_list(CommonVarsSet, CommonVars),
|
|
|
|
% downsize OldSharingSet to contain only information regarding the
|
|
% common vars, hence a full projection...
|
|
sharing_set_project(inproject, CommonVars,
|
|
OldSharingSet, OldSharingSetProjected),
|
|
% As each and every pair within OldMapProjected needs to be looked at,
|
|
% we might as well use the full list representation:
|
|
OldSharingPairs = to_sharing_pair_list(OldSharingSetProjected),
|
|
%
|
|
% Now for each sharing pair X-Y represented by OldMapProjected, find
|
|
% all the datastructures in NewSharingMap that cover X, find
|
|
% all the datastructures in NewSharingMap that cover Y, and compute
|
|
% the crossproduct of both sets returning the set of new sharing pairs.
|
|
%
|
|
list.foldl(
|
|
pred(X - Y::in, SS0::in, SS::out) is det :-
|
|
(
|
|
ExtendedX = sharing_set_extend_datastruct(ModuleInfo, ProcInfo, X,
|
|
NewSharingSet),
|
|
ExtendedY = sharing_set_extend_datastruct(ModuleInfo, ProcInfo, Y,
|
|
NewSharingSet),
|
|
set_cross_product(set.from_list(ExtendedX),
|
|
set.from_list(ExtendedY), SetPairs),
|
|
new_entries(ModuleInfo, ProcInfo,
|
|
set.to_sorted_list(SetPairs), SS0, SS)
|
|
),
|
|
OldSharingPairs,
|
|
sharing_set_init,
|
|
ResultSharingSet).
|
|
|
|
% SharingSet1 is subsumed by SharingSet2 iff every sharing pair
|
|
% represented by SharingSet1 is subsumed by any of the sharing pairs
|
|
% represented by SharingSet2.
|
|
% XXX For the moment SharingSet1 is converted to a list of sharing pairs,
|
|
% and each of the sharing pairs is checked for subsumption. This should be
|
|
% optimised to follow the inner structure of sharing_set instead.
|
|
%
|
|
sharing_set_is_subsumed_by(ModuleInfo, ProcInfo, SharingSet1, SharingSet2):-
|
|
list.all_true(sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo,
|
|
SharingSet2), to_sharing_pair_list(SharingSet1)).
|
|
|
|
sharing_set_least_upper_bound(ModuleInfo, ProcInfo, Set1, Set2) = Union :-
|
|
% Folding over the map could be done, but the union is easier to describe
|
|
% by picking each of the sharing pairs represented by the smallest sharing
|
|
% set, and adding them to the other sharing set.
|
|
Set1 = sharing_set(Size1, _),
|
|
Set2 = sharing_set(Size2, _),
|
|
( Size1 < Size2 ->
|
|
Pairs = to_sharing_pair_list(Set1),
|
|
Set = Set2
|
|
;
|
|
Pairs = to_sharing_pair_list(Set2),
|
|
Set = Set1
|
|
),
|
|
new_entries(ModuleInfo, ProcInfo, Pairs, Set, Union).
|
|
|
|
:- func sharing_set_least_upper_bound_list(module_info, proc_info,
|
|
list(sharing_set), sharing_set) = sharing_set.
|
|
|
|
sharing_set_least_upper_bound_list(ModuleInfo, ProcInfo, ListSharingSet,
|
|
SharingSet0) =
|
|
list.foldl(sharing_set_least_upper_bound(ModuleInfo, ProcInfo),
|
|
ListSharingSet, SharingSet0).
|
|
|
|
sharing_set_extend_datastruct(ModuleInfo, ProcInfo, Datastruct, SharingSet)
|
|
= [Datastruct | Datastructures] :-
|
|
SharingSet = sharing_set(_, SharingMap),
|
|
Var = Datastruct ^ sc_var,
|
|
Selector = Datastruct ^ sc_selector,
|
|
( map.search(SharingMap, Var, SelectorSet) ->
|
|
% The type of the variable is needed to be able to compare
|
|
% datastructures.
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_type(VarTypes, Var, VarType),
|
|
Datastructures = selector_sharing_set_extend_datastruct(ModuleInfo,
|
|
ProcInfo, VarType, Selector, SelectorSet)
|
|
;
|
|
Datastructures = []
|
|
).
|
|
|
|
sharing_set_apply_widening(ModuleInfo, ProcInfo, !SharingSet):-
|
|
!.SharingSet = sharing_set(_, SharingMap0),
|
|
map.map_foldl(
|
|
selector_sharing_set_apply_widening(ModuleInfo, ProcInfo),
|
|
SharingMap0, SharingMap, 0, NewSize),
|
|
!:SharingSet = sharing_set(NewSize, SharingMap).
|
|
|
|
from_sharing_pair_list(SharingPairs) = SharingSet :-
|
|
list.foldl(new_entry_no_controls, SharingPairs, sharing_set_init,
|
|
SharingSet).
|
|
|
|
% Add a new sharing pair into the existing sharing set. This operation
|
|
% takes into account subsumption:
|
|
% * if the new sharing pair is subsumed by any of the sharing already
|
|
% present in the set, then this operation is a null operation.
|
|
% * if the new sharing pair subsumes any of the existing sharing, then
|
|
% all the subsumed sharing pairs must be removed.
|
|
%
|
|
% XXX
|
|
% Due to the above checks, this operation may become quite costly. To
|
|
% verify!
|
|
%
|
|
:- pred new_entry(module_info::in, proc_info::in, structure_sharing_pair::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
new_entry(ModuleInfo, ProcInfo, SharingPair0, !SharingSet) :-
|
|
SharingPair0 = DataX0 - DataY0,
|
|
% Normalize the sharing pair before doing anything.
|
|
DataX = normalize_datastruct(ModuleInfo, ProcInfo, DataX0),
|
|
DataY = normalize_datastruct(ModuleInfo, ProcInfo, DataY0),
|
|
SharingPair = DataX - DataY,
|
|
(
|
|
(
|
|
% Ignore sharing pairs which are exactly the same.
|
|
DataX = DataY
|
|
;
|
|
sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo,
|
|
!.SharingSet, SharingPair)
|
|
)
|
|
->
|
|
true
|
|
;
|
|
sharing_set_subsumed_subset(ModuleInfo, ProcInfo,
|
|
!.SharingSet, SharingPair, SubsumedPairs),
|
|
% For any two pairs (A,B) and (B,A) keep only one pair in the list.
|
|
% Otherwise we'll get an assertion failure in `remove_entries' when we
|
|
% try to remove (B,A) after having removed (A,B).
|
|
remove_swapped_dup_pairs(SubsumedPairs, [], SubsumedPairsNoDups),
|
|
remove_entries(SubsumedPairsNoDups, !SharingSet),
|
|
new_entry_no_controls(SharingPair, !SharingSet)
|
|
).
|
|
|
|
:- pred new_entry_no_controls(structure_sharing_pair::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
new_entry_no_controls(SharingPair, !SS) :-
|
|
SharingPair = Data1 - Data2,
|
|
new_directed_entry(Data1, Data2, !SS),
|
|
( datastruct_equal(Data1, Data2) ->
|
|
true
|
|
;
|
|
new_directed_entry(Data2, Data1, !SS)
|
|
).
|
|
|
|
:- pred remove_entries(structure_sharing::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
remove_entries(SharingPairs, !SS):-
|
|
list.foldl(remove_entry, SharingPairs, !SS).
|
|
|
|
% Remove a structure sharing pair that is known to be explicitly
|
|
% represented in the sharing set.
|
|
% Software error if the sharing pair is not part of the set.
|
|
%
|
|
:- pred remove_entry(structure_sharing_pair::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
remove_entry(SharingPair, !SharingSet) :-
|
|
SharingPair = Data1 - Data2,
|
|
remove_directed_entry(Data1, Data2, !SharingSet),
|
|
( datastruct_equal(Data1, Data2) ->
|
|
true
|
|
;
|
|
remove_directed_entry(Data2, Data1, !SharingSet)
|
|
).
|
|
|
|
:- pred remove_directed_entry(datastruct::in, datastruct::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
remove_directed_entry(FromData, ToData, SharingSet0, SharingSet) :-
|
|
FromVar = FromData ^ sc_var,
|
|
FromSel = FromData ^ sc_selector,
|
|
|
|
SharingSet0 = sharing_set(Size0, SharingMap0),
|
|
map.lookup(SharingMap0, FromVar, SelSharingSet0),
|
|
SelSharingSet0 = selector_sharing_set(SelSize0, SelSharingMap0),
|
|
map.lookup(SelSharingMap0, FromSel, DataSet0),
|
|
DataSet0 = datastructures(DataSize0, Data0),
|
|
( set.remove(ToData, Data0, Data) ->
|
|
DataSize = DataSize0 - 1,
|
|
SelSize = SelSize0 - 1,
|
|
Size = Size0 - 1,
|
|
|
|
( Size = 0 ->
|
|
SharingSet = sharing_set(Size, map.init)
|
|
; SelSize = 0 ->
|
|
map.delete(FromVar, SharingMap0, SharingMap),
|
|
SharingSet = sharing_set(Size, SharingMap)
|
|
; DataSize = 0 ->
|
|
map.delete(FromSel, SelSharingMap0, SelSharingMap),
|
|
SelSharingSet = selector_sharing_set(SelSize, SelSharingMap),
|
|
map.det_update(FromVar, SelSharingSet, SharingMap0, SharingMap),
|
|
SharingSet = sharing_set(Size, SharingMap)
|
|
;
|
|
DataSet = datastructures(DataSize, Data),
|
|
map.det_update(FromSel, DataSet, SelSharingMap0, SelSharingMap),
|
|
SelSharingSet = selector_sharing_set(SelSize, SelSharingMap),
|
|
map.det_update(FromVar, SelSharingSet, SharingMap0, SharingMap),
|
|
SharingSet = sharing_set(Size, SharingMap)
|
|
)
|
|
;
|
|
unexpected($module, $pred, "removing non-existant sharing pair")
|
|
).
|
|
|
|
% Determine if the sharing set subsumes the sharing information
|
|
% represented by the structure sharing pair.
|
|
% This means: \exists A-B \in SharingSet, such that A-B is more general
|
|
% than the given structure sharing pair.
|
|
%
|
|
:- pred sharing_set_subsumes_sharing_pair(module_info::in, proc_info::in,
|
|
sharing_set::in, structure_sharing_pair::in) is semidet.
|
|
|
|
sharing_set_subsumes_sharing_pair(ModuleInfo, ProcInfo, SharingSet,
|
|
SharingPair):-
|
|
SharingSet = sharing_set(_, SharingMap),
|
|
|
|
SharingPair = Data1 - Data2,
|
|
Data1 = selected_cel(Var1, Sel1),
|
|
Data2 = selected_cel(Var2, Sel2),
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type1, Sel1),
|
|
check_normalized(ModuleInfo, Type2, Sel2)
|
|
),
|
|
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_type(VarTypes, Var1, Type1),
|
|
lookup_var_type(VarTypes, Var2, Type2),
|
|
|
|
map.search(SharingMap, Var1, SelSharingSet),
|
|
SelSharingSet = selector_sharing_set(_, SelSharingMap),
|
|
map.keys(SelSharingMap, SelectorList),
|
|
|
|
% Find at least one selector in SelectorList that is more general
|
|
% than Sel1 (with a specific extension), and whose associated dataset
|
|
% contains at least one datastructure that is more general than Data2
|
|
% (with that same extension).
|
|
some [Sel] (
|
|
list.member(Sel, SelectorList),
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type1, Sel)
|
|
),
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
Sel1, Sel, Type1, Extension),
|
|
map.search(SelSharingMap, Sel, datastructures(_, DatastructureSet)),
|
|
|
|
some [Datastructure] (
|
|
set.member(Datastructure, DatastructureSet),
|
|
Var2 = Datastructure ^ sc_var,
|
|
DatastructureSel = Datastructure ^ sc_selector,
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type2, DatastructureSel)
|
|
),
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
Sel2, DatastructureSel, Type2, Extension)
|
|
)
|
|
).
|
|
|
|
% Return the list of sharing pairs included in the sharing set that are
|
|
% less or equal to the given sharing pair.
|
|
%
|
|
:- pred sharing_set_subsumed_subset(module_info::in, proc_info::in,
|
|
sharing_set::in, structure_sharing_pair::in, structure_sharing::out)
|
|
is det.
|
|
|
|
sharing_set_subsumed_subset(ModuleInfo, ProcInfo, SharingSet, SharingPair,
|
|
SubsumedPairs) :-
|
|
SharingSet = sharing_set(_, SharingMap),
|
|
|
|
SharingPair = Data1 - Data2,
|
|
Data1 = selected_cel(Var1, Sel1),
|
|
Data2 = selected_cel(Var2, Sel2),
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type1, Sel1),
|
|
check_normalized(ModuleInfo, Type2, Sel2)
|
|
),
|
|
|
|
proc_info_get_vartypes(ProcInfo, VarTypes),
|
|
lookup_var_type(VarTypes, Var1, Type1),
|
|
lookup_var_type(VarTypes, Var2, Type2),
|
|
|
|
( map.search(SharingMap, Var1, SelSharingSet) ->
|
|
SelSharingSet = selector_sharing_set(_, SelSharingMap),
|
|
%
|
|
% Determine all Selector-Dataset pairs where
|
|
% * Selector is less or equal to Sel1 wrt some extension E,
|
|
% * Dataset is a set of datastructures less or equal to Data2
|
|
% (wrt the same extension E).
|
|
%
|
|
map.keys(SelSharingMap, SelectorList),
|
|
list.filter_map(
|
|
(pred(Selector::in, SPairs::out) is semidet :-
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type1, Selector)
|
|
),
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
Selector, Sel1, Type1, Extension),
|
|
map.search(SelSharingMap, Selector, Dataset),
|
|
Dataset = datastructures(_, Datastructs),
|
|
list.filter_map(
|
|
(pred(D::in, Pair::out) is semidet :-
|
|
Var2 = D ^ sc_var,
|
|
DSel = D ^ sc_selector,
|
|
trace [
|
|
compile_time(flag("check_selector_normalization")),
|
|
run_time(env("check_selector_normalization"))
|
|
] (
|
|
check_normalized(ModuleInfo, Type2, DSel)
|
|
),
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
DSel, Sel2, Type2, Extension),
|
|
Pair = datastruct_init_with_selector(Var1, Selector)
|
|
- D
|
|
),
|
|
to_sorted_list(Datastructs),
|
|
SPairs),
|
|
SPairs = [_ | _]
|
|
),
|
|
SelectorList,
|
|
ListSubsumedPairs),
|
|
list.condense(ListSubsumedPairs, SubsumedPairs)
|
|
;
|
|
SubsumedPairs = []
|
|
).
|
|
|
|
:- pred remove_swapped_dup_pairs(list(structure_sharing_pair)::in,
|
|
list(structure_sharing_pair)::in, list(structure_sharing_pair)::out)
|
|
is det.
|
|
|
|
remove_swapped_dup_pairs([], Acc, Acc).
|
|
remove_swapped_dup_pairs([H | T], Acc0, Acc) :-
|
|
H = A - B,
|
|
( list.member(B - A, Acc0) ->
|
|
remove_swapped_dup_pairs(T, Acc0, Acc)
|
|
;
|
|
remove_swapped_dup_pairs(T, [H | Acc0], Acc)
|
|
).
|
|
|
|
:- pred check_normalized(module_info::in, mer_type::in, selector::in) is det.
|
|
|
|
check_normalized(ModuleInfo, Type, Sel) :-
|
|
normalize_selector_with_type_information(ModuleInfo, Type, Sel, Norm),
|
|
( Sel = Norm ->
|
|
true
|
|
;
|
|
unexpected($module, $pred, "unnormalized selector")
|
|
).
|
|
|
|
:- pred new_entries(module_info::in, proc_info::in, structure_sharing::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
new_entries(ModuleInfo, ProcInfo, SharingPairs, !SS) :-
|
|
list.foldl(new_entry(ModuleInfo, ProcInfo), SharingPairs, !SS).
|
|
|
|
:- pred new_directed_entry(datastruct::in, datastruct::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
new_directed_entry(FromData, ToData, SharingSet0, SharingSet):-
|
|
SharingSet0 = sharing_set(Size0, Map0),
|
|
Var = FromData ^ sc_var,
|
|
Selector = FromData ^ sc_selector,
|
|
( map.search(Map0, Var, Selectors0) ->
|
|
(
|
|
selector_sharing_set_new_entry(Selector, ToData,
|
|
Selectors0, Selectors)
|
|
->
|
|
map.det_update(Var, Selectors, Map0, Map),
|
|
Size = Size0 + 1
|
|
;
|
|
Map = Map0,
|
|
Size = Size0
|
|
)
|
|
;
|
|
(
|
|
selector_sharing_set_new_entry(Selector, ToData,
|
|
selector_sharing_set_init, Selectors)
|
|
->
|
|
map.det_insert(Var, Selectors, Map0, Map),
|
|
Size = Size0 + 1
|
|
;
|
|
unexpected($module, $pred, "impossible option")
|
|
)
|
|
),
|
|
SharingSet = sharing_set(Size, Map).
|
|
|
|
to_sharing_pair_list(SharingSet0) = SharingPairs :-
|
|
SharingSet = without_doubles(SharingSet0),
|
|
SharingSet = sharing_set(_, SharingMap),
|
|
map.foldl(to_sharing_pair_list_2, SharingMap, [], SharingPairs).
|
|
|
|
:- pred to_sharing_pair_list_2(prog_var::in, selector_sharing_set::in,
|
|
structure_sharing::in, structure_sharing::out) is det.
|
|
|
|
to_sharing_pair_list_2(ProgVar, SelSharingSet, !Pairs) :-
|
|
SelSharingSet = selector_sharing_set(_, SelectorMap),
|
|
map.foldl(to_sharing_pair_list_3(ProgVar), SelectorMap, !Pairs).
|
|
|
|
:- pred to_sharing_pair_list_3(prog_var::in, selector::in, data_set::in,
|
|
structure_sharing::in, structure_sharing::out) is det.
|
|
|
|
to_sharing_pair_list_3(ProgVar, Selector, Dataset, !Pairs) :-
|
|
Dataset = datastructures(_, Datastructs),
|
|
set.fold(to_sharing_pair_list_4(ProgVar, Selector), Datastructs, !Pairs).
|
|
|
|
:- pred to_sharing_pair_list_4(prog_var::in, selector::in, datastruct::in,
|
|
structure_sharing::in, structure_sharing::out) is det.
|
|
|
|
to_sharing_pair_list_4(ProgVar, Selector, Datastruct, !Pairs) :-
|
|
SharingPair =
|
|
Datastruct - datastruct_init_with_selector(ProgVar, Selector),
|
|
!:Pairs = [SharingPair | !.Pairs].
|
|
|
|
:- func without_doubles(sharing_set) = sharing_set.
|
|
|
|
without_doubles(SharingSet0) = SharingSet :-
|
|
SharingSet0 = sharing_set(_, Map0),
|
|
map.foldl(without_doubles_2, Map0, sharing_set_init, SharingSet).
|
|
|
|
:- pred without_doubles_2(prog_var::in, selector_sharing_set::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
without_doubles_2(ProgVar, SelectorSS, !SS) :-
|
|
SelectorSS = selector_sharing_set(_, SelMap),
|
|
map.foldl(without_doubles_3(ProgVar), SelMap, !SS).
|
|
|
|
:- pred without_doubles_3(prog_var::in, selector::in, data_set::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
without_doubles_3(ProgVar, Selector, DataSet, !SS) :-
|
|
DataSet = datastructures(_, DS),
|
|
set.fold(without_doubles_4(ProgVar, Selector), DS, !SS).
|
|
|
|
:- pred without_doubles_4(prog_var::in, selector::in, datastruct::in,
|
|
sharing_set::in, sharing_set::out) is det.
|
|
|
|
without_doubles_4(ProgVar, Selector, Datastruct, !SS) :-
|
|
(
|
|
directed_entry_is_member(
|
|
datastruct_init_with_selector(ProgVar, Selector),
|
|
Datastruct, !.SS)
|
|
->
|
|
true
|
|
;
|
|
new_directed_entry(Datastruct,
|
|
datastruct_init_with_selector(ProgVar, Selector), !SS)
|
|
).
|
|
|
|
:- pred directed_entry_is_member(datastruct::in, datastruct::in,
|
|
sharing_set::in) is semidet.
|
|
|
|
directed_entry_is_member(FromData, ToData, SharingSet) :-
|
|
SharingSet = sharing_set(_, Map),
|
|
Var = FromData ^ sc_var,
|
|
Selector = FromData ^ sc_selector,
|
|
map.search(Map, Var, SelSharingSet),
|
|
SelSharingSet = selector_sharing_set(_, SelectorMap),
|
|
map.search(SelectorMap, Selector, Dataset),
|
|
Dataset = datastructures(_, Datastructures),
|
|
set.member(ToData, Datastructures).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% selector_sharing_set predicates/functions
|
|
%
|
|
|
|
:- func selector_sharing_set_init = selector_sharing_set.
|
|
|
|
:- pred selector_sharing_set_is_empty(selector_sharing_set::in) is semidet.
|
|
|
|
:- func selector_sharing_set_size(selector_sharing_set) = int.
|
|
|
|
:- pred selector_sharing_set_project(projection_type::in, prog_vars::in,
|
|
selector_sharing_set::in, selector_sharing_set::out) is det.
|
|
|
|
:- pred selector_sharing_set_rename(prog_var_renaming::in,
|
|
tsubst::in, selector_sharing_set::in, selector_sharing_set::out) is det.
|
|
|
|
:- pred selector_sharing_set_add(selector_sharing_set::in,
|
|
selector_sharing_set::in, selector_sharing_set::out) is det.
|
|
|
|
% selector_sharing_set_new_entry(Selector, Datastruct, SS0, SS):
|
|
% Adds Datastruct into SS0 using Selector as a key. Fails if that
|
|
% Datastructs is already present with that selector.
|
|
%
|
|
:- pred selector_sharing_set_new_entry(selector::in, datastruct::in,
|
|
selector_sharing_set::in, selector_sharing_set::out) is semidet.
|
|
|
|
:- func selector_sharing_set_altclos(module_info, proc_info, mer_type,
|
|
selector_sharing_set, selector_sharing_set) = structure_sharing.
|
|
|
|
:- func selector_sharing_set_extend_datastruct(module_info, proc_info,
|
|
mer_type, selector, selector_sharing_set) = list(datastruct).
|
|
|
|
:- pred selector_sharing_set_apply_widening(module_info::in, proc_info::in,
|
|
prog_var::in, selector_sharing_set::in, selector_sharing_set::out,
|
|
int::in, int::out) is det.
|
|
|
|
selector_sharing_set_init = selector_sharing_set(0, map.init).
|
|
selector_sharing_set_is_empty(selector_sharing_set(0, _Map)).
|
|
selector_sharing_set_size(selector_sharing_set(Size, _)) = Size.
|
|
|
|
selector_sharing_set_project(ProjectionType, Vars,
|
|
SelSharingSet0, SelSharingSet):-
|
|
SelSharingSet0 = selector_sharing_set(_, Map0),
|
|
map.foldl(selector_sharing_set_project_2(ProjectionType, Vars),
|
|
Map0, selector_sharing_set_init, SelSharingSet).
|
|
|
|
:- pred selector_sharing_set_project_2(projection_type::in, prog_vars::in,
|
|
selector::in, data_set::in, selector_sharing_set::in,
|
|
selector_sharing_set::out) is det.
|
|
|
|
selector_sharing_set_project_2(ProjectionType, Vars, Selector, DataSet0, !SS):-
|
|
data_set_project(ProjectionType, Vars, DataSet0, DataSet),
|
|
( data_set_is_empty(DataSet) ->
|
|
true
|
|
;
|
|
!.SS = selector_sharing_set(Size0, Map0),
|
|
map.det_insert(Selector, DataSet, Map0, Map),
|
|
Size = Size0 + data_set_size(DataSet),
|
|
!:SS = selector_sharing_set(Size, Map)
|
|
).
|
|
|
|
selector_sharing_set_rename(Dict, Subst, SelSharingSet0, SelSharingSet):-
|
|
SelSharingSet0 = selector_sharing_set(Size, Map0),
|
|
map.foldl(selector_sharing_set_rename_2(Dict, Subst), Map0, map.init, Map),
|
|
SelSharingSet = selector_sharing_set(Size, Map).
|
|
|
|
:- pred selector_sharing_set_rename_2(prog_var_renaming::in,
|
|
tsubst::in, selector::in, data_set::in,
|
|
map(selector, data_set)::in, map(selector, data_set)::out) is det.
|
|
|
|
selector_sharing_set_rename_2(Dict, Subst, Selector0, DataSet0, !Map) :-
|
|
rename_selector(Subst, Selector0, Selector),
|
|
data_set_rename(Dict, Subst, DataSet0, DataSet),
|
|
( map.search(!.Map, Selector, DataSetOld) ->
|
|
% This can happen if Subst maps two different type variables to the
|
|
% same type.
|
|
data_set_add(DataSet, DataSetOld, CombinedDataSet),
|
|
map.set(Selector, CombinedDataSet, !Map)
|
|
;
|
|
map.det_insert(Selector, DataSet, !Map)
|
|
).
|
|
|
|
selector_sharing_set_add(SelectorSetA, SelectorSetB, SelectorSet):-
|
|
SelectorSetA = selector_sharing_set(_, MapA),
|
|
SelectorSetB = selector_sharing_set(_, MapB),
|
|
map.foldl(selector_sharing_set_add_2, MapA, MapB, Map),
|
|
map.foldl(sum_data_set_sizes, Map, 0, Size),
|
|
SelectorSet = selector_sharing_set(Size, Map).
|
|
|
|
:- pred selector_sharing_set_add_2(selector::in, data_set::in,
|
|
map(selector, data_set)::in, map(selector, data_set)::out) is det.
|
|
|
|
selector_sharing_set_add_2(Sel, DataSet0, !Map) :-
|
|
( map.search(!.Map, Sel, DataSet1) ->
|
|
data_set_add(DataSet0, DataSet1, DataSet),
|
|
map.det_update(Sel, DataSet, !Map)
|
|
;
|
|
map.det_insert(Sel, DataSet0, !Map)
|
|
).
|
|
|
|
:- pred sum_data_set_sizes(selector::in, data_set::in,
|
|
int::in, int::out) is det.
|
|
|
|
sum_data_set_sizes(_, DataSet, Size0, Size) :-
|
|
Size = Size0 + data_set_size(DataSet).
|
|
|
|
selector_sharing_set_new_entry(Selector, Datastruct,
|
|
SelSharingSet0, SelSharingSet) :-
|
|
SelSharingSet0 = selector_sharing_set(Size0, Map0),
|
|
( map.search(Map0, Selector, DataSet0) ->
|
|
data_set_new_entry(Datastruct, DataSet0, DataSet),
|
|
Size = Size0 + 1,
|
|
map.det_update(Selector, DataSet, Map0, Map)
|
|
;
|
|
data_set_new_entry(Datastruct, data_set_init, DataSet),
|
|
Size = Size0 + 1,
|
|
map.det_insert(Selector, DataSet, Map0, Map)
|
|
),
|
|
SelSharingSet = selector_sharing_set(Size, Map).
|
|
|
|
selector_sharing_set_altclos(ModuleInfo, ProcInfo, Type, NewSelSet, OldSelSet)
|
|
= NewSharingPairs :-
|
|
|
|
NewSelSet = selector_sharing_set(_, NewMap),
|
|
OldSelSet = selector_sharing_set(_, OldMap),
|
|
%
|
|
% Get the selectors.
|
|
%
|
|
map.keys(NewMap, NewSelectors),
|
|
map.keys(OldMap, OldSelectors),
|
|
%
|
|
% For each selector in NewSelectors, verify each selector in OldSelector,
|
|
% if either one is less or equal to the other, then generate the structure
|
|
% sharing pair as appropriate.
|
|
%
|
|
NewSharingPairs = list.condense(list.map(
|
|
selector_sharing_set_altclos_2(ModuleInfo, ProcInfo, Type, NewMap,
|
|
OldMap, OldSelectors),
|
|
NewSelectors)).
|
|
|
|
:- func selector_sharing_set_altclos_2(module_info, proc_info, mer_type,
|
|
map(selector, data_set), map(selector, data_set), list(selector),
|
|
selector) = structure_sharing.
|
|
|
|
selector_sharing_set_altclos_2(ModuleInfo, ProcInfo, Type, NewMap, OldMap,
|
|
OldSelectors, NewSel) = SharingPairs :-
|
|
map.lookup(NewMap, NewSel, NewSelDataSet),
|
|
SharingPairs = list.condense(list.map(
|
|
selector_sharing_set_altclos_3(ModuleInfo, ProcInfo, Type,
|
|
NewSelDataSet, OldMap, NewSel),
|
|
OldSelectors)).
|
|
|
|
:- func selector_sharing_set_altclos_3(module_info, proc_info, mer_type,
|
|
data_set, map(selector, data_set), selector, selector) = structure_sharing.
|
|
|
|
selector_sharing_set_altclos_3(ModuleInfo, ProcInfo, Type, NewSelDataSet,
|
|
OldMap, NewSel, OldSel) = SharingPairs :-
|
|
map.lookup(OldMap, OldSel, OldSelDataSet),
|
|
SharingPairs = basic_closure(ModuleInfo, ProcInfo, Type, NewSelDataSet,
|
|
OldSelDataSet, NewSel, OldSel).
|
|
|
|
:- func basic_closure(module_info, proc_info, mer_type,
|
|
data_set, data_set, selector, selector) = structure_sharing.
|
|
|
|
basic_closure(ModuleInfo, ProcInfo, Type, NewDataSet, OldDataSet,
|
|
NewSel, OldSel) = SharingPairs :-
|
|
% three cases:
|
|
% 1. NewSel <= OldSel then generate sharing pairs.
|
|
% 2. OldSel <= NewSel then generate sharing pairs.
|
|
% 3. NewSel and OldSet not comparable then no new sharing pairs.
|
|
|
|
(
|
|
% NewSel <= OldSel ie, \exists Extension: OldSel.Extension = NewSel.
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
NewSel, OldSel, Type, Extension)
|
|
->
|
|
data_set_termshift(ModuleInfo, ProcInfo, OldDataSet, Extension,
|
|
TermShiftedOldDataSet),
|
|
SharingPairs = data_set_directed_closure(TermShiftedOldDataSet,
|
|
NewDataSet)
|
|
;
|
|
% OldSel <= NewSel ie, \exists Extension: NewSel.Extension = OldSel.
|
|
selector_subsumed_by(ModuleInfo, already_normalized,
|
|
OldSel, NewSel, Type, Extension)
|
|
->
|
|
data_set_termshift(ModuleInfo, ProcInfo, NewDataSet, Extension,
|
|
TermShiftedNewDataSet),
|
|
SharingPairs = data_set_directed_closure(TermShiftedNewDataSet,
|
|
OldDataSet)
|
|
;
|
|
% uncomparable
|
|
SharingPairs = []
|
|
).
|
|
|
|
selector_sharing_set_extend_datastruct(ModuleInfo, ProcInfo, VarType, Selector,
|
|
SelectorSharingSet) = Datastructures :-
|
|
SelectorSharingSet = selector_sharing_set(_, SelectorMap),
|
|
DoExtend = selector_sharing_set_extend_datastruct_2(ModuleInfo, ProcInfo,
|
|
VarType, Selector),
|
|
Datastructures0 = map.map_values(DoExtend, SelectorMap),
|
|
Datastructures = list.condense(map.values(Datastructures0)).
|
|
|
|
:- func selector_sharing_set_extend_datastruct_2(module_info, proc_info,
|
|
mer_type, selector, selector, data_set) = list(datastruct).
|
|
|
|
selector_sharing_set_extend_datastruct_2(ModuleInfo, ProcInfo, VarType,
|
|
BaseSelector, Selector, Dataset0) = Datastructures :-
|
|
% If Selector is more general than BaseSelector, i.e.
|
|
% BaseSelector = Selector.Extension, apply this extension
|
|
% to all the datastructs associated with Selector, and add them
|
|
% to the set of datastructs collected.
|
|
(
|
|
selector_subsumed_by(ModuleInfo, need_normalization,
|
|
BaseSelector, Selector, VarType, Extension)
|
|
->
|
|
data_set_termshift(ModuleInfo, ProcInfo, Dataset0, Extension, Dataset),
|
|
Dataset = datastructures(_, Data),
|
|
Datastructures = set.to_sorted_list(Data)
|
|
;
|
|
Datastructures = []
|
|
).
|
|
|
|
selector_sharing_set_apply_widening(ModuleInfo, ProcInfo, ProgVar,
|
|
!SelectorSharingSet, !SharingSetSize):-
|
|
!.SelectorSharingSet = selector_sharing_set(_, DataMap0),
|
|
map.foldl2(
|
|
selector_sharing_set_apply_widening_2(ModuleInfo, ProcInfo, ProgVar),
|
|
DataMap0, map.init, DataMap, 0, DataMapSize),
|
|
!:SharingSetSize = !.SharingSetSize + DataMapSize,
|
|
!:SelectorSharingSet = selector_sharing_set(DataMapSize, DataMap).
|
|
|
|
:- pred selector_sharing_set_apply_widening_2(module_info::in, proc_info::in,
|
|
prog_var::in, selector::in, data_set::in, map(selector, data_set)::in,
|
|
map(selector, data_set)::out, int::in, int::out) is det.
|
|
|
|
selector_sharing_set_apply_widening_2(ModuleInfo, ProcInfo, ProgVar,
|
|
Selector, DataSet0, !DataMap, !DataMapSize) :-
|
|
% Widening of the associated datastructures.
|
|
data_set_apply_widening(ModuleInfo, ProcInfo, DataSet0, DataSet1),
|
|
|
|
% Widening of the ProgVar-Selector datastructure.
|
|
datastruct_apply_widening(ModuleInfo, ProcInfo,
|
|
datastruct_init_with_selector(ProgVar, Selector), NewDataStruct),
|
|
NewSelector = NewDataStruct ^ sc_selector,
|
|
|
|
% Remove any occurrence of ProgVar-NewSelector in the data set, i.e. before
|
|
% widening the left- and right-hand sides of a sharing pair were different,
|
|
% but after widening they became identical.
|
|
data_set_delete_entry(NewDataStruct, DataSet1, DataSet2),
|
|
|
|
% Check if NewSelector is already in the resulting DataMap, if so,
|
|
% compute the least upper bound of the associated data_set's.
|
|
( map.search(!.DataMap, NewSelector, ExistingDataSet) ->
|
|
ExistingDataSetSize = data_set_size(ExistingDataSet),
|
|
DataSetFinal = data_set_least_upper_bound(ModuleInfo, ProcInfo,
|
|
DataSet2, ExistingDataSet),
|
|
DataSetFinalSize = data_set_size(DataSetFinal),
|
|
map.det_update(NewSelector, DataSetFinal, !DataMap),
|
|
!:DataMapSize = !.DataMapSize - ExistingDataSetSize + DataSetFinalSize
|
|
;
|
|
map.det_insert(NewSelector, DataSet2, !DataMap),
|
|
!:DataMapSize = !.DataMapSize + data_set_size(DataSet2)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% data_set predicates/functions
|
|
%
|
|
|
|
:- func data_set_init = data_set.
|
|
|
|
:- pred data_set_is_empty(data_set::in) is semidet.
|
|
|
|
:- func data_set_size(data_set) = int.
|
|
|
|
:- pred data_set_project(projection_type::in, prog_vars::in,
|
|
data_set::in, data_set::out) is det.
|
|
|
|
:- pred data_set_rename(prog_var_renaming::in, tsubst::in,
|
|
data_set::in, data_set::out) is det.
|
|
|
|
:- pred data_set_termshift(module_info::in, proc_info::in, data_set::in,
|
|
selector::in, data_set::out) is det.
|
|
|
|
:- pred data_set_add(data_set::in, data_set::in, data_set::out) is det.
|
|
|
|
:- pred data_set_new_entry(datastruct::in, data_set::in, data_set::out)
|
|
is semidet.
|
|
|
|
:- pred data_set_delete_entry(datastruct::in, data_set::in, data_set::out)
|
|
is det.
|
|
|
|
:- func data_set_directed_closure(data_set, data_set) = structure_sharing.
|
|
|
|
:- pred data_set_apply_widening(module_info::in, proc_info::in,
|
|
data_set::in, data_set::out) is det.
|
|
|
|
:- func data_set_least_upper_bound(module_info, proc_info,
|
|
data_set, data_set) = data_set.
|
|
|
|
data_set_init = datastructures(0, set.init).
|
|
|
|
data_set_is_empty(datastructures(0, _Set)).
|
|
|
|
data_set_size(datastructures(Size, _)) = Size.
|
|
|
|
data_set_project(ProjectionType, Vars, !DataSet) :-
|
|
data_set_filter(data_set_project_test(ProjectionType, Vars), !DataSet).
|
|
|
|
:- pred data_set_project_test(projection_type::in, prog_vars::in,
|
|
datastruct::in) is semidet.
|
|
|
|
data_set_project_test(ProjectionType, Vars, Data) :-
|
|
Var = Data ^ sc_var,
|
|
(
|
|
ProjectionType = inproject,
|
|
list.member(Var, Vars)
|
|
;
|
|
ProjectionType = outproject,
|
|
not list.member(Var, Vars)
|
|
).
|
|
|
|
data_set_rename(Dict, Subst, !DataSet) :-
|
|
!.DataSet = datastructures(_Size, Datastructs0),
|
|
Datastructs = set.map(rename_datastruct(Dict, Subst), Datastructs0),
|
|
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
|
|
|
|
data_set_termshift(ModuleInfo, ProcInfo, DataSet0, Selector, DataSet) :-
|
|
DataSet0 = datastructures(Size, Set0),
|
|
Set = set.map(datastruct_termshift(ModuleInfo, ProcInfo, Selector), Set0),
|
|
DataSet = datastructures(Size, Set).
|
|
|
|
data_set_add(DataSetA, DataSetB, DataSet) :-
|
|
DataSetA = datastructures(_, DataA),
|
|
DataSetB = datastructures(_, DataB),
|
|
Data = set.union(DataA, DataB),
|
|
DataSet = datastructures(set.count(Data), Data).
|
|
|
|
data_set_new_entry(Datastruct, DataSet0, DataSet) :-
|
|
DataSet0 = datastructures(Size0, Datastructs0),
|
|
\+ set.member(Datastruct, Datastructs0),
|
|
set.insert(Datastruct, Datastructs0, Datastructs),
|
|
Size = Size0 + 1,
|
|
DataSet = datastructures(Size, Datastructs).
|
|
|
|
data_set_delete_entry(Datastruct, DataSet0, DataSet) :-
|
|
DataSet0 = datastructures(Size0, Datastructs0),
|
|
( set.contains(Datastructs0, Datastruct) ->
|
|
set.delete(Datastruct, Datastructs0, Datastructs),
|
|
Size = Size0 - 1,
|
|
DataSet = datastructures(Size, Datastructs)
|
|
;
|
|
DataSet = DataSet0
|
|
).
|
|
|
|
data_set_directed_closure(FromData, ToData) = SharingPairs :-
|
|
FromData = datastructures(_, DataSet1),
|
|
ToData = datastructures(_, DataSet2),
|
|
set_cross_product(DataSet1, DataSet2, SetOfPairs),
|
|
set.to_sorted_list(SetOfPairs, SharingPairs).
|
|
|
|
:- pred set_cross_product(set(datastruct)::in, set(datastruct)::in,
|
|
set(pair(datastruct, datastruct))::out) is det.
|
|
|
|
set_cross_product(SetA, SetB, CrossProduct):-
|
|
solutions_set(cross_product(SetA, SetB), CrossProduct).
|
|
|
|
:- pred cross_product(set(datastruct)::in, set(datastruct)::in,
|
|
pair(datastruct, datastruct)::out) is nondet.
|
|
|
|
cross_product(SetA, SetB, Pair) :-
|
|
set.member(ElemA, SetA),
|
|
set.member(ElemB, SetB),
|
|
Pair = ElemA - ElemB.
|
|
|
|
:- pred data_set_filter(pred(datastruct)::in(pred(in) is semidet),
|
|
data_set::in, data_set::out) is det.
|
|
|
|
data_set_filter(Pred, !DataSet) :-
|
|
!.DataSet = datastructures(_, Datastructs0),
|
|
Datastructs = set.filter(Pred, Datastructs0),
|
|
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
|
|
|
|
data_set_least_upper_bound(ModuleInfo, ProcInfo, DataSet1, DataSet2)
|
|
= DataSet :-
|
|
DataSet1 = datastructures(_, Datastructs1),
|
|
DataSet2 = datastructures(_, Datastructs2),
|
|
set.fold(data_set_add_datastruct(ModuleInfo, ProcInfo),
|
|
Datastructs1, Datastructs2, Datastructs),
|
|
DataSet = datastructures(set.count(Datastructs), Datastructs).
|
|
|
|
:- pred data_set_add_datastruct(module_info::in, proc_info::in,
|
|
datastruct::in, set(datastruct)::in, set(datastruct)::out) is det.
|
|
|
|
data_set_add_datastruct(ModuleInfo, ProcInfo, Data, !Datastructs) :-
|
|
(
|
|
% Perform the simple check of exact occurrence in the set first...
|
|
set.member(Data, !.Datastructs)
|
|
->
|
|
true
|
|
;
|
|
datastruct_subsumed_by_list(ModuleInfo, ProcInfo, Data,
|
|
set.to_sorted_list(!.Datastructs))
|
|
->
|
|
true
|
|
;
|
|
set.insert(Data, !Datastructs)
|
|
).
|
|
|
|
data_set_apply_widening(ModuleInfo, ProcInfo, !DataSet):-
|
|
% XXX ProcInfo could be replaced by a mercury type, as all the
|
|
% datastructures within one single dataset have the same type
|
|
% (as they are sharing with one and the same datastruct, hence,
|
|
% they must have the same type as that datastruct).
|
|
!.DataSet = datastructures(_, Datastructs0),
|
|
set.fold(data_set_widen_and_add(ModuleInfo, ProcInfo),
|
|
Datastructs0, set.init, Datastructs),
|
|
!:DataSet = datastructures(set.count(Datastructs), Datastructs).
|
|
|
|
:- pred data_set_widen_and_add(module_info::in, proc_info::in, datastruct::in,
|
|
set(datastruct)::in, set(datastruct)::out) is det.
|
|
|
|
data_set_widen_and_add(ModuleInfo, ProcInfo, Data0, !Datastructs):-
|
|
datastruct_apply_widening(ModuleInfo, ProcInfo, Data0, Data),
|
|
data_set_add_datastruct(ModuleInfo, ProcInfo, Data, !Datastructs).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module transform_hlds.ctgc.structure_sharing.domain.
|
|
%-----------------------------------------------------------------------------%
|