mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
825 lines
29 KiB
Mathematica
825 lines
29 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2006, 2008-2012 The University of Melbourne.
|
|
% Copyright (C) 2015-2024 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: prog_ctgc.m.
|
|
% Main author: nancy.
|
|
%
|
|
% Utility operations (parsing, printing, renaming) for compile-time garbage
|
|
% collection related information, i.e. structure sharing and structure reuse.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module parse_tree.prog_ctgc.
|
|
:- interface.
|
|
|
|
:- import_module parse_tree.parse_tree_output.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_pragma.
|
|
:- import_module parse_tree.var_db.
|
|
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module term.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Parsing routines.
|
|
%
|
|
|
|
:- func parse_unit_selector(term(T)) = unit_selector.
|
|
|
|
:- func parse_selector(term(T)) = selector.
|
|
|
|
:- func parse_datastruct(term(T)) = datastruct.
|
|
|
|
:- func parse_structure_sharing_pair(term(T)) = structure_sharing_pair.
|
|
|
|
:- func parse_structure_sharing(term(T)) = structure_sharing.
|
|
|
|
:- func parse_structure_sharing_domain(term(T)) = structure_sharing_domain.
|
|
|
|
:- func parse_structure_reuse_condition(term(T)) = structure_reuse_condition.
|
|
|
|
:- func parse_structure_reuse_conditions(term(T))
|
|
= list(structure_reuse_condition).
|
|
|
|
:- func parse_structure_reuse_domain(term(T)) = structure_reuse_domain.
|
|
|
|
:- pred parse_user_annotated_sharing(varset::in, term::in,
|
|
user_annotated_sharing::out) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Printing routines.
|
|
%
|
|
|
|
% Print structure sharing or reuse information as a Mercury comment.
|
|
% This is used in HLDS dumps.
|
|
%
|
|
:- pred dump_structure_sharing_domain(S::in, var_name_source::in, tvarset::in,
|
|
structure_sharing_domain::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
:- pred format_interface_structure_sharing_domain(S::in,
|
|
var_name_source::in, tvarset::in, maybe(structure_sharing_domain)::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
% Print structure sharing or reuse information as a Mercury comment.
|
|
% This is used in HLDS dumps.
|
|
%
|
|
:- pred dump_structure_reuse_domain(S::in, var_name_source::in, tvarset::in,
|
|
structure_reuse_domain::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
:- pred format_interface_maybe_structure_reuse_domain(S::in,
|
|
var_name_source::in, tvarset::in, maybe(structure_reuse_domain)::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Renaming operations.
|
|
%
|
|
|
|
:- pred rename_unit_selector(tsubst::in, unit_selector::in,
|
|
unit_selector::out) is det.
|
|
|
|
:- pred rename_selector(tsubst::in, selector::in, selector::out) is det.
|
|
|
|
:- pred rename_datastruct(map(prog_var, prog_var)::in, tsubst::in,
|
|
datastruct::in, datastruct::out) is det.
|
|
|
|
:- pred rename_structure_sharing_pair(map(prog_var, prog_var)::in,
|
|
tsubst::in, structure_sharing_pair::in, structure_sharing_pair::out)
|
|
is det.
|
|
|
|
:- pred rename_structure_sharing(map(prog_var, prog_var)::in,
|
|
tsubst::in, structure_sharing::in, structure_sharing::out) is det.
|
|
|
|
:- pred rename_structure_sharing_domain(map(prog_var, prog_var)::in,
|
|
tsubst::in, structure_sharing_domain::in,
|
|
structure_sharing_domain::out) is det.
|
|
|
|
:- pred rename_user_annotated_sharing(list(prog_var)::in, list(prog_var)::in,
|
|
list(mer_type)::in, user_annotated_sharing::in,
|
|
user_annotated_sharing::out) is det.
|
|
|
|
:- pred rename_structure_reuse_condition(map(prog_var, prog_var)::in,
|
|
tsubst::in, structure_reuse_condition::in,
|
|
structure_reuse_condition::out) is det.
|
|
|
|
:- pred rename_structure_reuse_conditions(map(prog_var, prog_var)::in,
|
|
tsubst::in, list(structure_reuse_condition)::in,
|
|
list(structure_reuse_condition)::out) is det.
|
|
|
|
:- pred rename_structure_reuse_domain(map(prog_var, prog_var)::in,
|
|
tsubst::in, structure_reuse_domain::in,
|
|
structure_reuse_domain::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module parse_tree.parse_sym_name.
|
|
:- import_module parse_tree.parse_tree_out_cons_id.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_misc.
|
|
:- import_module parse_tree.parse_tree_out_type.
|
|
:- import_module parse_tree.parse_type_name.
|
|
:- import_module parse_tree.prog_type_subst.
|
|
:- import_module parse_tree.prog_type_unify.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term_int.
|
|
:- import_module term_vars.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Parsing routines.
|
|
%
|
|
|
|
parse_unit_selector(Term) = UnitSelector :-
|
|
( if Term = term.functor(term.atom(Cons), Args, _) then
|
|
% XXX We should include non-dummy type_ctors in cons ConsIds.
|
|
% XXX Why do we parse int, float, and string ConsIds when they
|
|
% never have any arguments and thus cannot select anything?
|
|
( if
|
|
Cons = "sel",
|
|
Args = [ConsTerm, ArityTerm, PosTerm]
|
|
then
|
|
( if
|
|
try_parse_sym_name_and_no_args(ConsTerm, ConsIdName),
|
|
term_int.decimal_term_to_int(ArityTerm, Arity),
|
|
term_int.decimal_term_to_int(PosTerm, Pos)
|
|
then
|
|
ConsId = du_data_ctor(du_ctor(ConsIdName, Arity,
|
|
cons_id_dummy_type_ctor)),
|
|
UnitSelector = termsel(ConsId, Pos)
|
|
else if
|
|
% XXX UINT, presuambly we need to handle uints here too.
|
|
term_int.decimal_term_to_int(ConsTerm, Int)
|
|
then
|
|
ConsId = some_int_const(int_const(Int)),
|
|
UnitSelector = termsel(ConsId, 0)
|
|
else if
|
|
ConsTerm = term.functor(term.float(Float), _, _)
|
|
then
|
|
ConsId = float_const(Float),
|
|
UnitSelector = termsel(ConsId, 0)
|
|
else if
|
|
ConsTerm = term.functor(term.string(Str), _, _)
|
|
then
|
|
ConsId = string_const(Str),
|
|
UnitSelector = termsel(ConsId, 0)
|
|
else
|
|
unexpected($pred, "unknown cons_id in unit selector")
|
|
)
|
|
else if
|
|
Cons = "typesel",
|
|
Args = [TypeSelectorTerm]
|
|
then
|
|
( if
|
|
maybe_parse_type(
|
|
no_allow_ho_inst_info(wnhii_ctgc_type_selector),
|
|
term.coerce(TypeSelectorTerm), TypeSelector)
|
|
then
|
|
UnitSelector = typesel(TypeSelector)
|
|
else
|
|
unexpected($pred, "error in parsing type selector")
|
|
)
|
|
else
|
|
unexpected($pred, "selector is neither sel/3 nor typesel/1.")
|
|
)
|
|
else
|
|
unexpected($pred, "term not a functor")
|
|
).
|
|
|
|
parse_selector(Term) = Selector :-
|
|
( if Term = term.functor(term.atom(Cons), Args, _) then
|
|
( if
|
|
Cons = "[|]",
|
|
Args = [First, Rest]
|
|
then
|
|
Selector = [parse_unit_selector(First) | parse_selector(Rest)]
|
|
else
|
|
Selector = []
|
|
)
|
|
else
|
|
unexpected($pred, "term not a functor")
|
|
).
|
|
|
|
parse_datastruct(Term) = Datastruct :-
|
|
( if
|
|
Term = term.functor(term.atom(Cons), Args, _),
|
|
Cons = "cel",
|
|
Args = [VarTerm, SelectorTerm],
|
|
VarTerm = term.variable(Var, _)
|
|
then
|
|
Datastruct = selected_cel(term.coerce_var(Var),
|
|
parse_selector(SelectorTerm))
|
|
else
|
|
unexpected($pred, "error while parsing datastruct.")
|
|
).
|
|
|
|
:- func parse_datastruct_list(term(T)) = list(datastruct).
|
|
|
|
parse_datastruct_list(Term) = Datastructs :-
|
|
( if Term = term.functor(term.atom(Cons), Args, _) then
|
|
( if
|
|
Cons = "[|]",
|
|
Args = [FirstDataTerm, RestDataTerm]
|
|
then
|
|
Datastructs = [parse_datastruct(FirstDataTerm) |
|
|
parse_datastruct_list(RestDataTerm)]
|
|
else if
|
|
Cons = "[]"
|
|
then
|
|
Datastructs = []
|
|
else
|
|
unexpected($pred, "error while parsing list of datastructs")
|
|
)
|
|
else
|
|
unexpected($pred,
|
|
"error while parsing list of datastructs (term not a functor)")
|
|
).
|
|
|
|
parse_structure_sharing_pair(Term) = SharingPair :-
|
|
( if
|
|
Term = term.functor(term.atom(Cons), Args, _),
|
|
Cons = "pair",
|
|
Args = [First, Second]
|
|
then
|
|
SharingPair = parse_datastruct(First) - parse_datastruct(Second)
|
|
else
|
|
unexpected($pred, "error while parsing structure sharing pair")
|
|
).
|
|
|
|
parse_structure_sharing(Term) = SharingPairs :-
|
|
( if
|
|
Term = term.functor(term.atom(Cons), Args, _),
|
|
(
|
|
Cons = "[|]",
|
|
Args = [SharingPairTerm, Rest],
|
|
SharingPairs0 = [parse_structure_sharing_pair(SharingPairTerm) |
|
|
parse_structure_sharing(Rest)]
|
|
;
|
|
Cons = "[]",
|
|
SharingPairs0 = []
|
|
)
|
|
then
|
|
SharingPairs = SharingPairs0
|
|
else
|
|
unexpected($pred,
|
|
"error while parsing list of structure sharing pairs")
|
|
).
|
|
|
|
parse_structure_sharing_domain(Term) = SharingAs :-
|
|
( if
|
|
Term = term.functor(term.atom(Cons), _, _Context),
|
|
(
|
|
Cons = "[|]",
|
|
SharingAs0 = structure_sharing_real(parse_structure_sharing(Term))
|
|
;
|
|
Cons = "bottom",
|
|
SharingAs0 = structure_sharing_bottom
|
|
;
|
|
Cons = "top",
|
|
SharingAs0 = structure_sharing_top(
|
|
set.make_singleton_set(
|
|
top_cannot_improve("from parse_structure_sharing_domain")))
|
|
)
|
|
then
|
|
SharingAs = SharingAs0
|
|
else
|
|
unexpected($pred, "error while parsing structure sharing domain")
|
|
).
|
|
|
|
parse_structure_reuse_condition(Term) = ReuseCondition :-
|
|
( if Term = term.functor(term.atom(Cons), Args, _) then
|
|
( if
|
|
Cons = "condition",
|
|
Args = [DeadNodesTerm, InUseNodesTerm, SharingTerm]
|
|
then
|
|
DeadNodesList = parse_datastruct_list(DeadNodesTerm),
|
|
DeadNodes = set.list_to_set(DeadNodesList),
|
|
InUseNodes = parse_datastruct_list(InUseNodesTerm),
|
|
Sharing = parse_structure_sharing_domain(SharingTerm),
|
|
ReuseCondition = structure_reuse_condition(DeadNodes,
|
|
InUseNodes, Sharing)
|
|
else
|
|
unexpected($pred, "error while parsing reuse condition")
|
|
)
|
|
else
|
|
unexpected($pred,
|
|
"error while parsing reuse condition (term not a functor)")
|
|
).
|
|
|
|
parse_structure_reuse_conditions(Term) = ReuseConditions :-
|
|
( if Term = term.functor(term.atom(Cons), Args, _) then
|
|
( if
|
|
Cons = "[|]",
|
|
Args = [FirstTupleTerm, RestTuplesTerm]
|
|
then
|
|
ReuseConditions =
|
|
[parse_structure_reuse_condition(FirstTupleTerm) |
|
|
parse_structure_reuse_conditions(RestTuplesTerm)]
|
|
else if
|
|
Cons = "[]"
|
|
then
|
|
ReuseConditions = []
|
|
else
|
|
unexpected($pred, "error while parsing reuse conditions")
|
|
)
|
|
else
|
|
unexpected($pred,
|
|
"error while parsing reuse conditions (term not a functor)")
|
|
).
|
|
|
|
parse_structure_reuse_domain(Term) = ReuseDomain :-
|
|
( if
|
|
Term = term.functor(term.atom(Cons), Args, _)
|
|
then
|
|
( if
|
|
Cons = "has_no_reuse"
|
|
then
|
|
ReuseDomain = has_no_reuse
|
|
else if
|
|
Cons = "has_only_unconditional_reuse"
|
|
then
|
|
ReuseDomain = has_only_unconditional_reuse
|
|
else if
|
|
Cons = "has_conditional_reuse",
|
|
Args = [ReuseConditionsTerm]
|
|
then
|
|
ReuseDomain = has_conditional_reuse(
|
|
parse_structure_reuse_conditions(ReuseConditionsTerm))
|
|
else
|
|
unexpected($pred, "error while parsing reuse domain")
|
|
)
|
|
else
|
|
unexpected($pred,
|
|
"error while parsing reuse domain (term not a functor)")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
parse_user_annotated_sharing(!.Varset, Term, UserSharing) :-
|
|
(
|
|
Term = term.functor(term.atom("no_sharing"), [], _),
|
|
UserSharing = user_sharing(structure_sharing_bottom, no)
|
|
;
|
|
Term = term.functor(term.atom("unknown_sharing"), [], Context),
|
|
ContextStr = context_to_string(Context),
|
|
Msg = "user declared top(" ++ ContextStr ++ ")",
|
|
Reason = top_cannot_improve(Msg),
|
|
UserSharing = user_sharing(structure_sharing_top(
|
|
set.make_singleton_set(Reason)), no)
|
|
;
|
|
Term = term.functor(term.atom("sharing"),
|
|
[TypesTerm, UserSharingTerm], _),
|
|
(
|
|
TypesTerm = term.functor(term.atom("yes"), ListTypeTerms, _),
|
|
maybe_parse_types(no_allow_ho_inst_info(wnhii_user_struct_sharing),
|
|
ListTypeTerms, Types),
|
|
term_vars.vars_in_terms(ListTypeTerms, TypeVars),
|
|
varset.select(set.list_to_set(TypeVars), !Varset),
|
|
MaybeUserTypes = yes(user_type_info(Types,
|
|
varset.coerce(!.Varset)))
|
|
;
|
|
TypesTerm = term.functor(term.atom("no"), _, _),
|
|
MaybeUserTypes = no
|
|
),
|
|
parse_user_annotated_sharing_term(UserSharingTerm, Sharing),
|
|
UserSharing = user_sharing(Sharing, MaybeUserTypes)
|
|
).
|
|
|
|
:- pred parse_user_annotated_sharing_term(term::in,
|
|
structure_sharing_domain::out) is semidet.
|
|
|
|
parse_user_annotated_sharing_term(SharingDomainUserTerm, SharingDomain) :-
|
|
get_list_term_arguments(SharingDomainUserTerm, SharingPairTerms),
|
|
(
|
|
SharingPairTerms = [],
|
|
SharingDomain = structure_sharing_bottom
|
|
;
|
|
SharingPairTerms = [_ | _],
|
|
list.map(parse_user_annotated_sharing_pair_term, SharingPairTerms,
|
|
SharingPairs),
|
|
SharingDomain = structure_sharing_real(SharingPairs)
|
|
).
|
|
|
|
:- pred get_list_term_arguments(term::in, list(term)::out) is semidet.
|
|
|
|
get_list_term_arguments(ListTerm, ArgumentTerms) :-
|
|
ListTerm = term.functor(term.atom(Cons), Args, _),
|
|
(
|
|
Cons = "[|]",
|
|
Args = [FirstTerm, RestTerm],
|
|
get_list_term_arguments(RestTerm, RestList),
|
|
ArgumentTerms = [FirstTerm | RestList]
|
|
;
|
|
Cons = "[]",
|
|
ArgumentTerms = []
|
|
).
|
|
|
|
:- pred parse_user_annotated_sharing_pair_term(term::in,
|
|
structure_sharing_pair::out) is semidet.
|
|
|
|
parse_user_annotated_sharing_pair_term(Term, SharingPair) :-
|
|
Term = term.functor(term.atom("-"), [Left, Right], _),
|
|
parse_user_annotated_datastruct_term(Left, LeftData),
|
|
parse_user_annotated_datastruct_term(Right, RightData),
|
|
SharingPair = LeftData - RightData.
|
|
|
|
:- pred parse_user_annotated_datastruct_term(term::in, datastruct::out)
|
|
is semidet.
|
|
|
|
parse_user_annotated_datastruct_term(Term, Datastruct) :-
|
|
Term = term.functor(term.atom("cel"), [VarTerm, TypesTerm], _),
|
|
VarTerm = term.variable(GenericVar, _),
|
|
term.coerce_var(GenericVar, ProgVar),
|
|
get_list_term_arguments(TypesTerm, TypeTermsList),
|
|
maybe_parse_types(no_allow_ho_inst_info(wnhii_user_struct_sharing),
|
|
TypeTermsList, Types),
|
|
list.map(mer_type_to_typesel, Types, Selector),
|
|
Datastruct = selected_cel(ProgVar, Selector).
|
|
|
|
:- pred mer_type_to_typesel(mer_type::in, unit_selector::out) is det.
|
|
|
|
mer_type_to_typesel(Type, typesel(Type)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Printing routines.
|
|
%
|
|
|
|
:- pred format_selector(S::in, tvarset::in, selector::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_selector(S, TVarSet, Selector, !U) :-
|
|
add_string(selector_to_string(TVarSet, Selector), S, !U).
|
|
|
|
:- func selector_to_string(tvarset, selector) = string.
|
|
|
|
selector_to_string(TVarSet, Selector) = String :-
|
|
(
|
|
Selector = [],
|
|
String = "[]"
|
|
;
|
|
Selector = [_ | _],
|
|
SelectorStrings = list.map(unit_selector_to_string(TVarSet),
|
|
Selector),
|
|
string.append_list(["[", string.join_list(",", SelectorStrings), "]"],
|
|
String)
|
|
).
|
|
|
|
:- func unit_selector_to_string(tvarset, unit_selector) = string.
|
|
|
|
unit_selector_to_string(_, termsel(ConsId, Index)) =
|
|
string.append_list(["sel(",
|
|
mercury_cons_id_to_string(output_mercury, needs_brackets, ConsId),
|
|
",",
|
|
int_to_string(cons_id_arity(ConsId)),
|
|
",",
|
|
int_to_string(Index),
|
|
")"]).
|
|
|
|
unit_selector_to_string(TVarSet, typesel(TypeSel)) =
|
|
string.append_list(["typesel(",
|
|
mercury_type_to_string(TVarSet, print_name_only, TypeSel),
|
|
")"]).
|
|
|
|
%---------------------%
|
|
|
|
:- pred format_datastructs(S::in, var_name_source::in, tvarset::in,
|
|
list(datastruct)::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_datastructs(S, VarNameSrc, TypeVarSet, Datastructs, !U) :-
|
|
add_string("[", S, !U),
|
|
list.gap_foldl(format_datastruct(S, VarNameSrc, TypeVarSet),
|
|
add_string(", ", S), Datastructs, !U),
|
|
add_string("]", S, !U).
|
|
|
|
:- pred format_datastruct(S::in, var_name_source::in, tvarset::in,
|
|
datastruct::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_datastruct(S, VarNameSrc, TypeVarSet, DataStruct, !U) :-
|
|
lookup_var_name_in_source(VarNameSrc, DataStruct ^ sc_var, VarName),
|
|
add_string("cel(", S, !U),
|
|
add_string(VarName, S, !U),
|
|
add_string(", ", S, !U),
|
|
format_selector(S, TypeVarSet, DataStruct ^ sc_selector, !U),
|
|
add_string(")", S, !U).
|
|
|
|
%---------------------%
|
|
|
|
:- pred format_structure_sharing_pair(S::in, var_name_source::in, tvarset::in,
|
|
structure_sharing_pair::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_structure_sharing_pair(S, VarNameSrc, TypeVarSet, SharingPair, !U) :-
|
|
SharingPair = D1 - D2,
|
|
add_string("pair(", S, !U),
|
|
format_datastruct(S, VarNameSrc, TypeVarSet, D1, !U),
|
|
add_string(", ", S, !U),
|
|
format_datastruct(S, VarNameSrc, TypeVarSet, D2, !U),
|
|
add_string(")", S, !U).
|
|
|
|
% Print list of structure sharing pairs.
|
|
%
|
|
% format_structure_sharing(Varset, TVarset, MaybeThreshold,
|
|
% StartingString, Separator, EndingString, SharingPairs, !IO):
|
|
%
|
|
% Print the list of sharing pairs using StartString to precede the
|
|
% list, using EndString to end the list, using Separator to separate
|
|
% each of the sharing pairs occurring in the list. If a threshold, say
|
|
% N, is given, then only the first N pairs are printed (and "..."
|
|
% is shown if there are more than N pairs).
|
|
%
|
|
:- pred format_structure_sharing(S::in, var_name_source::in, tvarset::in,
|
|
maybe(int)::in, string::in, string::in, string::in, structure_sharing::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_structure_sharing(S, VarNameSrc, TypeVarSet, MaybeLimit,
|
|
Start, Sep, End, SharingPairs0, !U) :-
|
|
(
|
|
MaybeLimit = yes(Limit),
|
|
list.take_upto(Limit, SharingPairs0, SharingPairs),
|
|
( if Limit >= list.length(SharingPairs0) then
|
|
CompleteList = yes
|
|
else
|
|
CompleteList = no
|
|
)
|
|
;
|
|
MaybeLimit = no,
|
|
SharingPairs = SharingPairs0,
|
|
CompleteList = yes
|
|
),
|
|
add_string(Start, S, !U),
|
|
list.gap_foldl(format_structure_sharing_pair(S, VarNameSrc, TypeVarSet),
|
|
add_string(Sep, S), SharingPairs, !U),
|
|
(
|
|
CompleteList = no,
|
|
add_string(Sep, S, !U),
|
|
add_string("...", S, !U)
|
|
;
|
|
CompleteList = yes
|
|
),
|
|
add_string(End, S, !U).
|
|
|
|
% Print complete list of structure sharing pairs as a list (using "[",
|
|
% ",", and "]"). This can later be parsed automatically.
|
|
%
|
|
:- pred format_structure_sharing_as_list(S::in, var_name_source::in,
|
|
tvarset::in, structure_sharing::in, U::di, U::uo) is det
|
|
<= pt_output(S, U).
|
|
:- pragma consider_used(pred(format_structure_sharing_as_list/6)).
|
|
|
|
format_structure_sharing_as_list(S, VarNameSrc, TypeVarSet,
|
|
SharingPairs, !U) :-
|
|
format_structure_sharing(S, VarNameSrc, TypeVarSet, no, "[", ",", "]",
|
|
SharingPairs, !U).
|
|
|
|
% Print structure sharing domain.
|
|
%
|
|
% format_structure_sharing_domain(P, T, VerboseTop, MaybeThreshold,
|
|
% Sharing, !IO):
|
|
%
|
|
% If VerboseTop = yes, then the full list of reasons why sharing is
|
|
% top is printed as "top([ ... Messages ... ])". If VerboseTop = no,
|
|
% then top is printed as "top".
|
|
% If a threshold is given, say N, then only the first N structure
|
|
% sharing pairs are printed.
|
|
%
|
|
% The output can later be parsed again only if VerboseTop = no and
|
|
% MaybeThreshold = no.
|
|
%
|
|
:- pred format_structure_sharing_domain(S::in, var_name_source::in,
|
|
tvarset::in, bool::in, maybe(int)::in, structure_sharing_domain::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_structure_sharing_domain(S, VarNameSrc, TypeVarSet, VerboseTop,
|
|
MaybeThreshold, SharingAs, !U) :-
|
|
do_format_structure_sharing_domain(S, VarNameSrc, TypeVarSet,
|
|
VerboseTop, MaybeThreshold, "", ", ", "", SharingAs, !U).
|
|
|
|
:- pred do_format_structure_sharing_domain(S::in, var_name_source::in,
|
|
tvarset::in, bool::in, maybe(int)::in, string::in, string::in, string::in,
|
|
structure_sharing_domain::in, U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
do_format_structure_sharing_domain(S, VarNameSrc, TypeVarSet, VerboseTop,
|
|
MaybeThreshold, Start, Separator, End, SharingAs, !U) :-
|
|
add_string(Start, S, !U),
|
|
(
|
|
SharingAs = structure_sharing_top(Msgs),
|
|
(
|
|
VerboseTop = no,
|
|
add_string("top", S, !U)
|
|
;
|
|
VerboseTop = yes,
|
|
MsgStrs = list.map(string.string, set.to_sorted_list(Msgs)),
|
|
add_string("top([", S, !U),
|
|
add_list(add_string, Separator, MsgStrs, S, !U),
|
|
add_string("])", S, !U)
|
|
)
|
|
;
|
|
SharingAs = structure_sharing_bottom,
|
|
add_string("bottom", S, !U)
|
|
;
|
|
SharingAs = structure_sharing_real(SharingPairs),
|
|
format_structure_sharing(S, VarNameSrc, TypeVarSet,
|
|
MaybeThreshold, "[", Separator, "]", SharingPairs, !U)
|
|
),
|
|
add_string(End, S, !U).
|
|
|
|
dump_structure_sharing_domain(S, VarNameSrc, TypeVarSet, SharingAs, !U) :-
|
|
do_format_structure_sharing_domain(S, VarNameSrc, TypeVarSet, yes, no,
|
|
"%\t ", "\n%\t", "\n", SharingAs, !U).
|
|
|
|
format_interface_structure_sharing_domain(S, VarNameSrc, TypeVarSet,
|
|
MaybeSharingAs, !U) :-
|
|
(
|
|
MaybeSharingAs = no,
|
|
add_string("not_available", S, !U)
|
|
;
|
|
MaybeSharingAs = yes(SharingAs),
|
|
add_string("yes(", S, !U),
|
|
format_structure_sharing_domain(S, VarNameSrc, TypeVarSet,
|
|
no, no, SharingAs, !U),
|
|
add_string(")", S, !U)
|
|
).
|
|
|
|
dump_structure_reuse_domain(S, VarNameSrc, TypeVarSet, ReuseAs, !U) :-
|
|
format_structure_reuse_domain(S, VarNameSrc, TypeVarSet, ReuseAs,
|
|
"%\t ", ", \n%\t ", "\n", !U).
|
|
|
|
:- pred format_structure_reuse_condition(S::in, var_name_source::in,
|
|
tvarset::in, structure_reuse_condition::in, U::di, U::uo) is det
|
|
<= pt_output(S, U).
|
|
|
|
format_structure_reuse_condition(S, VarNameSrc, TypeVarSet, ReuseCond, !U) :-
|
|
ReuseCond = structure_reuse_condition(DeadNodes, InUseNodes, Sharing),
|
|
DeadNodesList = set.to_sorted_list(DeadNodes),
|
|
add_string("condition(", S, !U),
|
|
format_datastructs(S, VarNameSrc, TypeVarSet, DeadNodesList, !U),
|
|
add_string(", ", S, !U),
|
|
format_datastructs(S, VarNameSrc, TypeVarSet, InUseNodes, !U),
|
|
add_string(", ", S, !U),
|
|
format_structure_sharing_domain(S, VarNameSrc, TypeVarSet, no, no,
|
|
Sharing, !U),
|
|
add_string(")", S, !U).
|
|
|
|
:- pred format_structure_reuse_conditions(S::in, var_name_source::in,
|
|
tvarset::in, string::in, list(structure_reuse_condition)::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_structure_reuse_conditions(S, VarNameSrc, TypeVarSet, Separator,
|
|
ReuseConds, !U) :-
|
|
list.gap_foldl(
|
|
format_structure_reuse_condition(S, VarNameSrc, TypeVarSet),
|
|
add_string(Separator, S), ReuseConds, !U).
|
|
|
|
:- pred format_structure_reuse_domain(S::in, var_name_source::in, tvarset::in,
|
|
structure_reuse_domain::in, string::in, string::in, string::in,
|
|
U::di, U::uo) is det <= pt_output(S, U).
|
|
|
|
format_structure_reuse_domain(S, VarNameSrc, TypeVarSet, ReuseDomain,
|
|
Start, Separator, End, !U) :-
|
|
add_string(Start, S, !U),
|
|
(
|
|
ReuseDomain = has_no_reuse,
|
|
add_string("has_no_reuse", S, !U)
|
|
;
|
|
ReuseDomain = has_only_unconditional_reuse,
|
|
add_string("has_only_unconditional_reuse", S, !U)
|
|
;
|
|
ReuseDomain = has_conditional_reuse(ReuseConditions),
|
|
add_string("has_conditional_reuse([", S, !U),
|
|
format_structure_reuse_conditions(S, VarNameSrc, TypeVarSet,
|
|
Separator, ReuseConditions, !U),
|
|
add_string("])", S, !U)
|
|
),
|
|
add_string(End, S, !U).
|
|
|
|
format_interface_maybe_structure_reuse_domain(S, VarNameSrc, TypeVarSet,
|
|
MaybeReuseDomain, !U) :-
|
|
(
|
|
MaybeReuseDomain = no,
|
|
add_string("not_available", S, !U)
|
|
;
|
|
MaybeReuseDomain = yes(ReuseDomain),
|
|
add_string("yes(", S, !U),
|
|
format_structure_reuse_domain(S, VarNameSrc, TypeVarSet,
|
|
ReuseDomain, "", ", ", "", !U),
|
|
add_string(")", S, !U)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Renaming operations.
|
|
%
|
|
|
|
rename_unit_selector(Subst, !UnitSelector) :-
|
|
(
|
|
!.UnitSelector = termsel(_,_)
|
|
;
|
|
!.UnitSelector = typesel(Type0),
|
|
prog_type_subst.apply_subst_to_type(Subst, Type0, Type),
|
|
!:UnitSelector = typesel(Type)
|
|
).
|
|
|
|
rename_selector(TypeSubst, !Selector) :-
|
|
list.map(rename_unit_selector(TypeSubst), !Selector).
|
|
|
|
rename_datastruct(Dict, Subst, !Data) :-
|
|
!.Data = selected_cel(Var0, Sel0),
|
|
map.lookup(Dict, Var0, Var),
|
|
rename_selector(Subst, Sel0, Sel),
|
|
!:Data = selected_cel(Var, Sel).
|
|
|
|
rename_structure_sharing_pair(Dict, TypeSubst, !Pair) :-
|
|
!.Pair = D1 - D2,
|
|
rename_datastruct(Dict, TypeSubst, D1, Da),
|
|
rename_datastruct(Dict, TypeSubst, D2, Db),
|
|
!:Pair = Da - Db.
|
|
|
|
rename_structure_sharing(Dict, TypeSubst, !List) :-
|
|
list.map(rename_structure_sharing_pair(Dict, TypeSubst), !List).
|
|
|
|
rename_structure_sharing_domain(_, _, X @ structure_sharing_bottom, X).
|
|
rename_structure_sharing_domain(_, _, X @ structure_sharing_top(_), X).
|
|
rename_structure_sharing_domain(Dict, TypeSubst,
|
|
structure_sharing_real(!.List), structure_sharing_real(!:List)):-
|
|
rename_structure_sharing(Dict, TypeSubst, !List).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
rename_user_annotated_sharing(HeadVars, NewHeadVars, NewTypes,
|
|
!UserSharing) :-
|
|
(
|
|
!.UserSharing = no_user_annotated_sharing
|
|
;
|
|
!.UserSharing = user_sharing(Sharing, MaybeTypes),
|
|
some [!SharingDomain] (
|
|
!:SharingDomain = Sharing,
|
|
(
|
|
!.SharingDomain = structure_sharing_bottom
|
|
;
|
|
!.SharingDomain = structure_sharing_top(_)
|
|
;
|
|
!.SharingDomain = structure_sharing_real(SharingPairs),
|
|
map.from_corresponding_lists(HeadVars, NewHeadVars,
|
|
VarRenaming),
|
|
( if
|
|
MaybeTypes = yes(user_type_info(UserSharingTypes,
|
|
_UserSharingTVarSet))
|
|
then
|
|
type_list_subsumes_det(UserSharingTypes, NewTypes,
|
|
TypeSubst)
|
|
else
|
|
TypeSubst = map.init
|
|
),
|
|
rename_structure_sharing(VarRenaming, TypeSubst,
|
|
SharingPairs, NewSharingPairs),
|
|
!:SharingDomain = structure_sharing_real(NewSharingPairs)
|
|
),
|
|
!:UserSharing = user_sharing(!.SharingDomain, no)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
rename_structure_reuse_condition(Dict, TypeSubst,
|
|
structure_reuse_condition(DeadNodes, LiveNodes, Sharing),
|
|
structure_reuse_condition(RenDeadNodes, RenLiveNodes, RenSharing)) :-
|
|
set.map(rename_datastruct(Dict, TypeSubst), DeadNodes, RenDeadNodes),
|
|
list.map(rename_datastruct(Dict, TypeSubst), LiveNodes, RenLiveNodes),
|
|
rename_structure_sharing_domain(Dict, TypeSubst, Sharing, RenSharing).
|
|
|
|
rename_structure_reuse_conditions(Dict, TypeSubst, Conds, RenConds) :-
|
|
list.map(rename_structure_reuse_condition(Dict, TypeSubst),
|
|
Conds, RenConds).
|
|
|
|
rename_structure_reuse_domain(_, _, has_no_reuse, has_no_reuse).
|
|
rename_structure_reuse_domain(_, _, has_only_unconditional_reuse,
|
|
has_only_unconditional_reuse).
|
|
rename_structure_reuse_domain(Dict, TypeSubst, has_conditional_reuse(Conds),
|
|
has_conditional_reuse(RenConds)):-
|
|
rename_structure_reuse_conditions(Dict, TypeSubst, Conds, RenConds).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module parse_tree.prog_ctgc.
|
|
%---------------------------------------------------------------------------%
|