%-----------------------------------------------------------------------------% % 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. %-----------------------------------------------------------------------------%