mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
ffb963b30f
Traditionally, we always wrote out parse trees (of .intN files, for example)
to a file. However, we have also supported being able to write out *parts*
of parse trees to strings, because that ability is useful e.g.
- in error messages, printing the code that the error message is about,
- when debugging.
We are considering a use case which requires the ability to write out
the *whole* parse tree of a .intN file to a string. That use case is
comparing whether the old and new versions of a .intN file are identical
or not, because we want to update the actual .intN file only if they
differ. (Updating the .intN file if they are identical could trigger
the unnecessary recompilation of an unbounded number of other modules.)
Previously, we have done this comparison by writing out the new parse tree
to an .intN.tmp file, and compared it to the .intN file. It should be simpler
and quite possibly faster to
- read in the old .intN file as a string
- convert the new parse tree to a string
- compare the two strings
- write out the new string if and only if it differs from the old string.
This should be especially so if we can open the .intN file in read-write mode,
so the file would need to be opened just once, in step one, even if we do
need to write out the new parse tree in step four.
compiler/parse_tree_out.m:
Add functions to convert parse_tree_int[0123]s to strings.
To avoid having to reimplement all the code that currently writes
out those parse trees, convert the current predicates that always do I/O
into predicates that use the methods of the existing pt_output type class,
which, depending on the selected instance, can either do I/O or can build
up a string. This conversion has already been done for the constructs
that make up some parts of those parse trees; this diff extends the
conversion to every construct that is part of parse trees listed above.
As part of our existing conventions, predicates that have been
generalized in this way have the "output" or "write" in their names
replaced with "format".
We also perform this generalization for the predicates that write out
parse_tree_srcs and parse_tree_module_srcs, because doing so requires
almost no extra code.
compiler/parse_item.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_info.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_misc.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_type_repn.m:
compiler/prog_ctgc.m:
Perform the generalization discussed above, both on predicates
that write out Mercury constructs, and on some auxiliary predicates.
In a few cases, the generalized versions already existed but were private,
in which case this diff just exports them.
In a few cases, rename predicates to avoid ambiguities.
compiler/add_clause.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_type_table.m:
compiler/hlds_out_typeclass_table.m:
compiler/intermod.m:
compiler/intermod_analysis.m:
Conform to the changes above.
827 lines
29 KiB
Mathematica
827 lines
29 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2006, 2008-2011 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: 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_out_info.
|
|
:- 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)) = structure_reuse_conditions.
|
|
|
|
:- 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.
|
|
|
|
:- func rename_datastruct(map(prog_var, prog_var), tsubst, datastruct)
|
|
= datastruct.
|
|
|
|
:- 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, structure_reuse_conditions::in,
|
|
structure_reuse_conditions::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_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 = cons(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),
|
|
context_to_string(Context, ContextString),
|
|
Msg = "user declared top(" ++ ContextString ++ ")",
|
|
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_datastruct(Dict, Subst, Data0) = Data :-
|
|
rename_datastruct(Dict, Subst, Data0, Data).
|
|
|
|
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)) :-
|
|
RenDeadNodes = set.map(rename_datastruct(Dict, TypeSubst), DeadNodes),
|
|
RenLiveNodes = list.map(rename_datastruct(Dict, TypeSubst), LiveNodes),
|
|
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.
|
|
%---------------------------------------------------------------------------%
|