mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-22 21:03:53 +00:00
585c5f6165
The reason for this is that without such limits,
- the generation of a HLDS dump for the valid/inst_perf_bug_2 test case
takes almost forever, and
- generates a multi-gigabyte HLDS dump, which causes e.g. vim to take
forever to open.
Making the generation and use of HLDS dumps practical is worth the cost
of losing some information. (Information you can't afford to generate
or to use is lost anyway.)
compiler/options.m:
doc/user_guide.texi.m:
Add a new option to limit the size of the insts we output
in the inst tables part of HLDS dumps. This option should allow users
to select the tradeoff between the amount of information being preserved
and the cost of generating/using that information.
compiler/hlds_out_module.m:
Pass the value of the new option to hlds_out_inst_table.m.
compiler/hlds_out_inst_table.m:
Specify the size limit when writing out insts as either the keys or
the values in the various kinds of inst tables.
compiler/parse_tree_to_term.m:
To implement those limits, add inst_to_limited_size_term and
inst_name_to_limited_size_term, versions of the old inst_to_term
and inst_name_to_term functions that truncate the given inst or inst name
at the given "size" if necessary. The measure of "size" is just
function symbols in the resulting term in most cases, though
we treat things that in practice never get too big, such as types,
as "one", regardless of the number of function symbols they contain.
To make the parallel between the old non-size-limiting and the new
size-limiting versions of the relevant codes easier to see, transform
the functions in the old code to predicates. (The new versions have
to be predicates to allow the size to be passed along in a state var.)
compiler/hlds_out_goal.m:
When we print out the argument modes of a unification, limit the depth
to which we write out the various insts to three. This should be
more than enough, because any inst that we now replace with "..."
should be available in the mode information of the atomic goal that
generates it, whether that goal is a unification or a call.
791 lines
29 KiB
Mathematica
791 lines
29 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2009-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: hlds_out_module.m.
|
|
% Main authors: conway, fjh.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.hlds_out.hlds_out_module.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
|
|
:- import_module io.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Print out an entire HLDS structure.
|
|
%
|
|
:- pred write_hlds(io.text_output_stream::in, module_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% XXX :- import_module hlds.pred_table.
|
|
% We actually use a type equivalence from pred_table.m (specifically,
|
|
% the fact that pred_id_table is a map), but we get an unused import warning
|
|
% for the above line anyway.
|
|
%
|
|
% The problem is as follows.
|
|
%
|
|
% - The write_preds predicate calls module_info_get_pred_id_table,
|
|
% whose output has type pred_id_table. Therefore logically, the type
|
|
% of the variable that holds this output is also pred_id_table,
|
|
% which means that logically, this module *does* use *something*
|
|
% exported by pred_table.m.
|
|
%
|
|
% - On the other hand, the equiv_type.m pass, which operates on the augmented
|
|
% compilation unit, expands out equivalence types. The type of the output
|
|
% argument of module_info_get_pred_id_table, pred_id_table, is thus
|
|
% replaced with map(pred_id, pred_info). None of those types is defined
|
|
% in pred_table.m, and this module uses nothing else exported from
|
|
% pred_table.m either. This is why code generation can succeed
|
|
% without importing pred_table.m, and this is also why we get the warning
|
|
% about pred_table.m being unused if we *do* import it.
|
|
%
|
|
% I (zs) see three ways of fixing this problem.
|
|
%
|
|
% - We could have equiv_type.m record, in every item in which it expands out
|
|
% a type equivalence (or, for the same reason, an inst or mode equivalence)
|
|
% defined in a given module, record the name of that module in a new field
|
|
% in that item. In this case, this would mean including the pred_table
|
|
% module in this new field in the pred decl item for
|
|
% module_info_get_pred_id_table. We would preserve the value of this field
|
|
% in the HLDS, e.g. in pred_infos. Then, when the code of this module
|
|
% references module_info_get_pred_id_table, the code generating unused
|
|
% module warnings would consider that reference to use not just the module
|
|
% that defines module_info_get_pred_id_table, but also all the modules
|
|
% recorded in the new "modules that defined expanded equivalences" field
|
|
% of its pred_info. And likewide for other entities that contain types,
|
|
% insts and/or modes that can be expanded.
|
|
%
|
|
% This approach would record this information on a per item basis
|
|
% because we want to avoid false positives. If module A imports module B,
|
|
% and module B contains a predicate p that refers to an equivalence type
|
|
% in module C, this fact should make module C appear used in module A
|
|
% if and only if module A actually *uses* predicate p.
|
|
%
|
|
% - We could add to every alternative in the mer_type, mer_inst and mer_mode
|
|
% types a new field that records the set of modules that defined the
|
|
% equivalence types, insts or modes in its construction. I mean that if
|
|
% the programmer writes map(pred_id, pred_info), then this set would be
|
|
% empty, but if the prgrammer writes pred_id_table, then, when replacing it
|
|
% with map(pred_id, pred_info), equiv_type.m would include the pred_table
|
|
% module in this set. Every compiler pass *but* unused imports would
|
|
% of course ignore this extra argument.
|
|
%
|
|
% A complication here is that unifications of mer_types, mer_insts and
|
|
% mer_modes would have to be done using code that ignores the new fields.
|
|
% Likewise, we wouldn't be able to use values of those types as keys
|
|
% in maps without canonicalizing this field, probably by setting it to the
|
|
% empty set.
|
|
%
|
|
% - We could simply NOT run equiv_type.m on the augmented compilation unit,
|
|
% and instead expand type equivalences during type checking, and inst and
|
|
% mode equivalences during mode checking. In both cases, we could record
|
|
% the modules defining the types, insts and modes expanded out as being used.
|
|
%
|
|
% The second solution is probably the easiest to implement, but it also comes
|
|
% with a high and persistent memory overhead, which is why I don't think
|
|
% it is a good idea. The first solution is the next easiest. The best solution
|
|
% is, I think, the third, but it is the hardest to retrofit to our existing
|
|
% implementation. (Though it would have been much easier to implement when
|
|
% originally writing the type and mode checkers :-()
|
|
|
|
:- import_module hlds.const_struct.
|
|
:- import_module hlds.hlds_class.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_dependency_graph.
|
|
:- import_module hlds.hlds_error_util.
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module hlds.hlds_out.hlds_out_inst_table.
|
|
:- import_module hlds.hlds_out.hlds_out_mode.
|
|
:- import_module hlds.hlds_out.hlds_out_pred.
|
|
:- import_module hlds.hlds_out.hlds_out_type_table.
|
|
:- import_module hlds.hlds_out.hlds_out_typeclass_table.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.pred_name.
|
|
:- import_module libs.
|
|
:- import_module libs.dependency_graph.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.parse_tree_out_cons_id.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_sym_name.
|
|
:- import_module parse_tree.parse_tree_out_type.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_pragma.
|
|
:- import_module parse_tree.prog_item.
|
|
:- import_module parse_tree.write_error_spec.
|
|
|
|
:- import_module bool.
|
|
:- import_module digraph.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module varset.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out (selected parts of) the entire HLDS.
|
|
%
|
|
|
|
write_hlds(Stream, ModuleInfo, !IO) :-
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_accumulating_option(Globals, dump_hlds_pred_id,
|
|
DumpPredIdStrs),
|
|
globals.lookup_accumulating_option(Globals, dump_hlds_pred_name,
|
|
DumpPredNames),
|
|
globals.lookup_bool_option(Globals, dump_hlds_spec_preds, DumpSpecPreds0),
|
|
globals.lookup_accumulating_option(Globals, dump_hlds_spec_preds_for,
|
|
DumpSpecPredTypeNames),
|
|
write_header(Stream, ModuleInfo, !IO),
|
|
Info = init_hlds_out_info(Globals, output_debug),
|
|
Lang = output_debug,
|
|
DumpOptions0 = Info ^ hoi_dump_hlds_options,
|
|
(
|
|
DumpSpecPredTypeNames = [],
|
|
DumpSpecPreds = DumpSpecPreds0
|
|
;
|
|
DumpSpecPredTypeNames = [_ | _],
|
|
DumpSpecPreds = yes
|
|
),
|
|
(
|
|
DumpSpecPreds = no,
|
|
DumpOptions = DumpOptions0
|
|
;
|
|
DumpSpecPreds = yes,
|
|
% Print unify (and compare and index) predicates.
|
|
DumpOptions = DumpOptions0 ++ "U"
|
|
),
|
|
( if
|
|
% If the user specifically requested one or more predicates and/or
|
|
% functions to be dumped, they won't be interested in the types,
|
|
% insts etc.
|
|
( DumpPredIdStrs = [_ | _]
|
|
; DumpPredNames = [_ | _]
|
|
; DumpSpecPreds = yes
|
|
)
|
|
then
|
|
true
|
|
else
|
|
( if string.contains_char(DumpOptions, 'I') then
|
|
module_info_get_avail_module_map(ModuleInfo, AvailModuleMap),
|
|
map.foldl(write_avail_entry(Stream), AvailModuleMap, !IO)
|
|
else
|
|
true
|
|
),
|
|
( if string.contains_char(DumpOptions, 'T') then
|
|
( if string.contains_char(DumpOptions, 'L') then
|
|
LocalOnly = yes
|
|
else
|
|
LocalOnly = no
|
|
),
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
module_info_get_instance_table(ModuleInfo, InstanceTable),
|
|
module_info_get_class_table(ModuleInfo, ClassTable),
|
|
write_type_table(Info, Stream, LocalOnly, TypeTable, !IO),
|
|
write_classes(Info, Stream, ClassTable, !IO),
|
|
write_instances(Info, Stream, InstanceTable, !IO)
|
|
else
|
|
true
|
|
),
|
|
( if string.contains_char(DumpOptions, 'M') then
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
module_info_get_mode_table(ModuleInfo, ModeTable),
|
|
globals.lookup_int_option(Globals, dump_hlds_inst_limit,
|
|
InstNumLimit),
|
|
globals.lookup_int_option(Globals, dump_hlds_inst_size_limit,
|
|
InstSizeLimit),
|
|
write_inst_table(Stream, Lang, InstNumLimit, InstSizeLimit,
|
|
InstTable, !IO),
|
|
write_mode_table(Stream, ModeTable, !IO)
|
|
else
|
|
true
|
|
),
|
|
( if string.contains_char(DumpOptions, 'Z') then
|
|
module_info_get_table_struct_map(ModuleInfo, TableStructMap),
|
|
write_table_structs(Stream, ModuleInfo, TableStructMap, !IO)
|
|
else
|
|
true
|
|
)
|
|
),
|
|
( if string.contains_char(DumpOptions, 'X') then
|
|
module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
|
|
write_const_struct_db(Stream, ConstStructDb, !IO)
|
|
else
|
|
true
|
|
),
|
|
( if
|
|
( string.contains_char(DumpOptions, 'x')
|
|
; DumpSpecPreds = yes
|
|
)
|
|
then
|
|
write_preds(Info, Stream, DumpSpecPreds, DumpSpecPredTypeNames,
|
|
Lang, ModuleInfo, !IO)
|
|
else
|
|
true
|
|
),
|
|
( if string.contains_char(DumpOptions, 'O') then
|
|
module_info_get_maybe_dependency_info(ModuleInfo, MaybeDependencyInfo),
|
|
(
|
|
MaybeDependencyInfo = no,
|
|
io.write_string(Stream, "% No dependency info\n\n", !IO)
|
|
;
|
|
MaybeDependencyInfo = yes(DependencyInfo),
|
|
write_dependency_info(Info, Stream, ModuleInfo,
|
|
DependencyInfo, !IO)
|
|
)
|
|
else
|
|
true
|
|
),
|
|
write_footer(Stream, ModuleInfo, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred write_header(io.text_output_stream::in, module_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_header(Stream, Module, !IO) :-
|
|
module_info_get_name(Module, ModuleName),
|
|
io.write_string(Stream, "% vim: ts=2 sw=2 ft=mercury\n\n", !IO),
|
|
io.format(Stream, ":- module %s.\n\n",
|
|
[s(sym_name_to_escaped_string(ModuleName))], !IO).
|
|
|
|
:- pred write_footer(io.text_output_stream::in, module_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_footer(Stream, Module, !IO) :-
|
|
module_info_get_name(Module, ModuleName),
|
|
io.format(Stream, ":- end_module %s.\n",
|
|
[s(sym_name_to_escaped_string(ModuleName))], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out the imports and uses.
|
|
%
|
|
|
|
:- pred write_avail_entry(io.text_output_stream::in, module_name::in,
|
|
avail_module_entry::in, io::di, io::uo) is det.
|
|
|
|
write_avail_entry(Stream, ModuleName, Entry, !IO) :-
|
|
Entry = avail_module_entry(Section, ImportOrUse, Avails),
|
|
(
|
|
ImportOrUse = import_decl,
|
|
ImportOrUseDecl = "import_module"
|
|
;
|
|
ImportOrUse = use_decl,
|
|
ImportOrUseDecl = "use_module"
|
|
),
|
|
io.format(Stream, ":- %s %s.\n",
|
|
[s(ImportOrUseDecl), s(sym_name_to_escaped_string(ModuleName))], !IO),
|
|
io.write_string(Stream, "% ", !IO),
|
|
io.write(Stream, Section, !IO),
|
|
io.write_string(Stream, ", ", !IO),
|
|
io.write_line(Stream, Avails, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out constant structs defined in the module.
|
|
%
|
|
|
|
:- pred write_const_struct_db(io.text_output_stream::in, const_struct_db::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_const_struct_db(Stream, ConstStructDb, !IO) :-
|
|
const_struct_db_get_structs(ConstStructDb, ConstStructs),
|
|
io.write_string(Stream, "%-------- Const structs --------\n\n", !IO),
|
|
list.foldl(write_const_struct(Stream), ConstStructs, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
:- pred write_const_struct(io.text_output_stream::in,
|
|
pair(int, const_struct)::in, io::di, io::uo) is det.
|
|
|
|
write_const_struct(Stream, N - ConstStruct, !IO) :-
|
|
io.format(Stream, "\nconst_struct %d:\n", [i(N)], !IO),
|
|
ConstStruct = const_struct(ConsId, ConstArgs, Type, Inst, DefinedWhere),
|
|
mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId,
|
|
Stream, !IO),
|
|
(
|
|
ConstArgs = [],
|
|
io.nl(Stream, !IO)
|
|
;
|
|
ConstArgs = [HeadConstArg | TailConstArgs],
|
|
io.write_string(Stream, "(\n", !IO),
|
|
write_const_struct_args(Stream, HeadConstArg, TailConstArgs, !IO),
|
|
io.write_string(Stream, ")\n", !IO)
|
|
),
|
|
io.write_string(Stream, "type: ", !IO),
|
|
mercury_output_type(varset.init, print_name_only, Type, Stream, !IO),
|
|
io.nl(Stream, !IO),
|
|
io.write_string(Stream, "inst: ", !IO),
|
|
mercury_output_structured_inst(Stream, output_debug, varset.init,
|
|
do_not_incl_addr, 0, Inst, !IO),
|
|
(
|
|
DefinedWhere = defined_in_this_module,
|
|
io.write_string(Stream, "defined_in_this_module\n", !IO)
|
|
;
|
|
DefinedWhere = defined_in_other_module,
|
|
io.write_string(Stream, "defined_in_other_module\n", !IO)
|
|
).
|
|
|
|
:- pred write_const_struct_args(io.text_output_stream::in,
|
|
const_struct_arg::in, list(const_struct_arg)::in, io::di, io::uo) is det.
|
|
|
|
write_const_struct_args(Stream, HeadConstArg, TailConstArgs, !IO) :-
|
|
io.write_string(Stream, " ", !IO),
|
|
(
|
|
HeadConstArg = csa_const_struct(N),
|
|
io.format(Stream, "cs(%d)", [i(N)], !IO)
|
|
;
|
|
HeadConstArg = csa_constant(ConsId, Type),
|
|
mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId,
|
|
Stream, !IO),
|
|
io.write_string(Stream, "\n with type ", !IO),
|
|
mercury_output_type(varset.init, print_name_only, Type, Stream, !IO)
|
|
),
|
|
(
|
|
TailConstArgs = [],
|
|
io.write_string(Stream, "\n", !IO)
|
|
;
|
|
TailConstArgs = [HeadTailConstArg | TailTailConstArgs],
|
|
io.write_string(Stream, ",\n", !IO),
|
|
write_const_struct_args(Stream,
|
|
HeadTailConstArg, TailTailConstArgs, !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out tabling structs defined in the module.
|
|
%
|
|
|
|
:- pred write_table_structs(io.text_output_stream::in, module_info::in,
|
|
table_struct_map::in, io::di, io::uo) is det.
|
|
|
|
write_table_structs(Stream, ModuleInfo, TableStructMap, !IO) :-
|
|
map.to_assoc_list(TableStructMap, TableStructs),
|
|
io.write_string(Stream, "%-------- Table structs --------\n", !IO),
|
|
list.foldl(write_table_struct_info(Stream, ModuleInfo), TableStructs, !IO),
|
|
io.nl(Stream, !IO).
|
|
|
|
:- pred write_table_struct_info(io.text_output_stream::in, module_info::in,
|
|
pair(pred_proc_id, table_struct_info)::in, io::di, io::uo) is det.
|
|
|
|
write_table_struct_info(Stream, ModuleInfo, PredProcId - TableStructInfo,
|
|
!IO) :-
|
|
PredProcIdStr = pred_proc_id_to_dev_string(ModuleInfo, PredProcId),
|
|
io.format(Stream, "\n%% table struct info for %s\n",
|
|
[s(PredProcIdStr)], !IO),
|
|
TableStructInfo = table_struct_info(ProcTableStructInfo, Attributes),
|
|
ProcTableStructInfo = proc_table_struct_info(_ProcLabel, TVarSet, _Context,
|
|
NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, ArgInfos,
|
|
_EvalMethod),
|
|
io.format(Stream, "%% #inputs: %d, #outputs: %d\n",
|
|
[i(NumInputs), i(NumOutputs)], !IO),
|
|
io.write_string(Stream, "% input steps:", !IO),
|
|
list.foldl(write_space_and_table_trie_step(Stream, TVarSet),
|
|
InputSteps, !IO),
|
|
io.nl(Stream, !IO),
|
|
(
|
|
MaybeOutputSteps = yes(OutputSteps),
|
|
io.write_string(Stream, "% output steps:", !IO),
|
|
list.foldl(write_space_and_table_trie_step(Stream, TVarSet),
|
|
OutputSteps, !IO),
|
|
io.nl(Stream, !IO)
|
|
;
|
|
MaybeOutputSteps = no,
|
|
io.write_string(Stream, "% no output steps", !IO)
|
|
),
|
|
write_table_arg_infos(Stream, TVarSet, ArgInfos, !IO),
|
|
|
|
Attributes = table_attributes(Strictness, SizeLimit, Stats, AllowReset,
|
|
BackendWarning),
|
|
(
|
|
Strictness = cts_all_strict,
|
|
io.write_string(Stream, "% all strict\n", !IO)
|
|
;
|
|
Strictness = cts_all_fast_loose,
|
|
io.write_string(Stream, "% all fast_loose\n", !IO)
|
|
;
|
|
Strictness = cts_specified(ArgMethods, HiddenArgMethod),
|
|
io.write_string(Stream, "% specified [", !IO),
|
|
write_arg_tabling_methods(Stream, "", ArgMethods, !IO),
|
|
io.write_string(Stream, "]", !IO),
|
|
(
|
|
HiddenArgMethod = table_hidden_arg_value,
|
|
io.write_string(Stream, ", hidden args by value\n", !IO)
|
|
;
|
|
HiddenArgMethod = table_hidden_arg_addr,
|
|
io.write_string(Stream, ", hidden args by addr\n", !IO)
|
|
)
|
|
),
|
|
(
|
|
SizeLimit = no,
|
|
io.write_string(Stream, "% no size limit\n", !IO)
|
|
;
|
|
SizeLimit = yes(Limit),
|
|
io.format(Stream, "%% size limit %d\n", [i(Limit)], !IO)
|
|
),
|
|
(
|
|
Stats = table_gather_statistics,
|
|
io.write_string(Stream, "% gather statistics\n", !IO)
|
|
;
|
|
Stats = table_dont_gather_statistics,
|
|
io.write_string(Stream, "% do not gather statistics\n", !IO)
|
|
),
|
|
(
|
|
AllowReset = table_allow_reset,
|
|
io.write_string(Stream, "% allow reset\n", !IO)
|
|
;
|
|
AllowReset = table_dont_allow_reset,
|
|
io.write_string(Stream, "% do not allow reset\n", !IO)
|
|
),
|
|
(
|
|
BackendWarning = table_attr_ignore_with_warning,
|
|
io.write_string(Stream, "% ignore only with warning\n", !IO)
|
|
;
|
|
BackendWarning = table_attr_ignore_without_warning,
|
|
io.write_string(Stream, "% may ignore without warning\n", !IO)
|
|
).
|
|
|
|
:- pred write_space_and_table_trie_step(io.text_output_stream::in, tvarset::in,
|
|
table_step_desc::in, io::di, io::uo) is det.
|
|
|
|
write_space_and_table_trie_step(Stream, TVarSet, StepDesc, !IO) :-
|
|
StepDesc = table_step_desc(VarName, TrieStep),
|
|
StepDescStr = table_trie_step_desc(TVarSet, TrieStep),
|
|
io.format(Stream, " %s: %s", [s(VarName), s(StepDescStr)], !IO).
|
|
|
|
:- func table_trie_step_desc(tvarset, table_trie_step) = string.
|
|
|
|
table_trie_step_desc(TVarSet, Step) = Str :-
|
|
(
|
|
Step = table_trie_step_int(int_type_int),
|
|
Str = "int"
|
|
;
|
|
Step = table_trie_step_int(int_type_uint),
|
|
Str = "uint"
|
|
;
|
|
Step = table_trie_step_int(int_type_int8),
|
|
Str = "int8"
|
|
;
|
|
Step = table_trie_step_int(int_type_uint8),
|
|
Str = "uint8"
|
|
;
|
|
Step = table_trie_step_int(int_type_int16),
|
|
Str = "int16"
|
|
;
|
|
Step = table_trie_step_int(int_type_uint16),
|
|
Str = "uint16"
|
|
;
|
|
Step = table_trie_step_int(int_type_int32),
|
|
Str = "int32"
|
|
;
|
|
Step = table_trie_step_int(int_type_uint32),
|
|
Str = "uint32"
|
|
;
|
|
Step = table_trie_step_int(int_type_int64),
|
|
Str = "int64"
|
|
;
|
|
Step = table_trie_step_int(int_type_uint64),
|
|
Str = "uint64"
|
|
;
|
|
Step = table_trie_step_char,
|
|
Str = "char"
|
|
;
|
|
Step = table_trie_step_string,
|
|
Str = "string"
|
|
;
|
|
Step = table_trie_step_float,
|
|
Str = "float"
|
|
;
|
|
Step = table_trie_step_dummy,
|
|
Str = "dummy"
|
|
;
|
|
Step = table_trie_step_enum(N),
|
|
Str = string.format("enum(%d)", [i(N)])
|
|
;
|
|
Step = table_trie_step_foreign_enum,
|
|
Str = "foreign_enum"
|
|
;
|
|
Step = table_trie_step_general(Type, IsPoly, IsAddr),
|
|
TypeStr = mercury_type_to_string(TVarSet, print_name_and_num, Type),
|
|
(
|
|
IsPoly = table_is_poly,
|
|
IsPolyStr = "poly"
|
|
;
|
|
IsPoly = table_is_mono,
|
|
IsPolyStr = "mono"
|
|
),
|
|
(
|
|
IsAddr = table_value,
|
|
IsAddrStr = "value"
|
|
;
|
|
IsAddr = table_addr,
|
|
IsAddrStr = "addr"
|
|
),
|
|
Str = string.format("general(%s, %s, %s)",
|
|
[s(TypeStr), s(IsPolyStr), s(IsAddrStr)])
|
|
;
|
|
Step = table_trie_step_typeinfo,
|
|
Str = "typeinfo"
|
|
;
|
|
Step = table_trie_step_typeclassinfo,
|
|
Str = "typeclassinfo"
|
|
;
|
|
Step = table_trie_step_promise_implied,
|
|
Str = "promise_implied"
|
|
).
|
|
|
|
:- pred write_arg_tabling_methods(io.text_output_stream::in, string::in,
|
|
list(maybe(arg_tabling_method))::in, io::di, io::uo) is det.
|
|
|
|
write_arg_tabling_methods(_, _, [], !IO).
|
|
write_arg_tabling_methods(Stream, Prefix, [MaybeMethod | MaybeMethods], !IO) :-
|
|
io.write_string(Stream, Prefix, !IO),
|
|
(
|
|
MaybeMethod = no,
|
|
io.write_string(Stream, "output", !IO)
|
|
;
|
|
MaybeMethod = yes(arg_value),
|
|
io.write_string(Stream, "value", !IO)
|
|
;
|
|
MaybeMethod = yes(arg_addr),
|
|
io.write_string(Stream, "addr", !IO)
|
|
;
|
|
MaybeMethod = yes(arg_promise_implied),
|
|
io.write_string(Stream, "promise_implied", !IO)
|
|
),
|
|
write_arg_tabling_methods(Stream, ", ", MaybeMethods, !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out the predicate table.
|
|
%
|
|
|
|
:- pred write_preds(hlds_out_info::in, io.text_output_stream::in,
|
|
bool::in, list(string)::in, output_lang::in, module_info::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_preds(Info, Stream, DumpSpecPreds, DumpSpecPredTypeNames, Lang,
|
|
ModuleInfo, !IO) :-
|
|
io.write_string(Stream, "%-------- Predicates --------\n\n", !IO),
|
|
module_info_get_pred_id_table(ModuleInfo, PredIdTable),
|
|
map.to_assoc_list(PredIdTable, PredIdsInfos),
|
|
(
|
|
DumpSpecPreds = no,
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, dump_hlds_pred_name_order,
|
|
NameOrder),
|
|
(
|
|
NameOrder = no,
|
|
PrintPredIdsInfos = PredIdsInfos
|
|
;
|
|
NameOrder = yes,
|
|
list.sort(compare_in_name_order, PredIdsInfos, PrintPredIdsInfos)
|
|
)
|
|
;
|
|
DumpSpecPreds = yes,
|
|
map.init(SpecPredMap0),
|
|
list.foldl(add_spec_preds_to_map(DumpSpecPredTypeNames), PredIdsInfos,
|
|
SpecPredMap0, SpecPredMap),
|
|
map.values(SpecPredMap, PrintPredIdsInfos)
|
|
),
|
|
list.foldl(maybe_write_pred(Info, Stream, Lang, ModuleInfo),
|
|
PrintPredIdsInfos, !IO).
|
|
|
|
:- pred compare_in_name_order(
|
|
pair(pred_id, pred_info)::in,
|
|
pair(pred_id, pred_info)::in,
|
|
comparison_result::out) is det.
|
|
|
|
compare_in_name_order(PredIdA - PredInfoA, PredIdB - PredInfoB, Result) :-
|
|
pred_info_get_name(PredInfoA, PredNameA),
|
|
pred_info_get_name(PredInfoB, PredNameB),
|
|
compare(NameResult, PredNameA, PredNameB),
|
|
(
|
|
( NameResult = (<)
|
|
; NameResult = (>)
|
|
),
|
|
Result = NameResult
|
|
;
|
|
NameResult = (=),
|
|
compare(Result, PredIdA, PredIdB)
|
|
).
|
|
|
|
:- pred add_spec_preds_to_map(list(string)::in, pair(pred_id, pred_info)::in,
|
|
map({type_ctor, special_pred_id}, pair(pred_id, pred_info))::in,
|
|
map({type_ctor, special_pred_id}, pair(pred_id, pred_info))::out) is det.
|
|
|
|
add_spec_preds_to_map(DumpSpecPredTypeNames, PredIdInfo, !SpecPredMap) :-
|
|
PredIdInfo = _PredId - PredInfo,
|
|
pred_info_get_origin(PredInfo, Origin),
|
|
( if Origin = origin_compiler(made_for_uci(SpecialPredId, TypeCtor)) then
|
|
(
|
|
DumpSpecPredTypeNames = [],
|
|
map.det_insert({TypeCtor, SpecialPredId}, PredIdInfo, !SpecPredMap)
|
|
;
|
|
DumpSpecPredTypeNames = [_ | _],
|
|
TypeCtor = type_ctor(TypeCtorSymName, _TypeCtorArity),
|
|
TypeCtorName = unqualify_name(TypeCtorSymName),
|
|
( if list.member(TypeCtorName, DumpSpecPredTypeNames) then
|
|
map.det_insert({TypeCtor, SpecialPredId}, PredIdInfo,
|
|
!SpecPredMap)
|
|
else
|
|
true
|
|
)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred maybe_write_pred(hlds_out_info::in, io.text_output_stream::in,
|
|
output_lang::in, module_info::in, pair(pred_id, pred_info)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
maybe_write_pred(Info, Stream, Lang, ModuleInfo, PredId - PredInfo,
|
|
!IO) :-
|
|
DumpOptions = Info ^ hoi_dump_hlds_options,
|
|
DumpPredIdStrs = Info ^ hoi_dump_hlds_pred_ids,
|
|
DumpPredNames = Info ^ hoi_dump_hlds_pred_names,
|
|
pred_id_to_int(PredId, PredIdInt),
|
|
( if
|
|
% If the user requested one or more predicates/functions to be dumped,
|
|
% we dump them even if the condition of the nested if-then-else below
|
|
% would say they shouldn't be dumped, and we don't dump anything else.
|
|
( DumpPredIdStrs = [_ | _]
|
|
; DumpPredNames = [_ | _]
|
|
)
|
|
then
|
|
( if
|
|
(
|
|
some [DumpPredIdStr, DumpPredId] (
|
|
list.member(DumpPredIdStr, DumpPredIdStrs),
|
|
string.to_int(DumpPredIdStr, DumpPredId),
|
|
PredIdInt = DumpPredId
|
|
)
|
|
;
|
|
PredName = pred_info_name(PredInfo),
|
|
list.member(PredName, DumpPredNames)
|
|
)
|
|
then
|
|
write_pred(Info, Stream, Lang, ModuleInfo, PredId, PredInfo, !IO)
|
|
else
|
|
true
|
|
)
|
|
else
|
|
( if
|
|
(
|
|
not string.contains_char(DumpOptions, 'I'),
|
|
pred_info_is_imported(PredInfo)
|
|
;
|
|
% For pseudo-imported predicates (i.e. unification preds),
|
|
% only print them if we are using a local mode for them.
|
|
not string.contains_char(DumpOptions, 'I'),
|
|
pred_info_is_pseudo_imported(PredInfo),
|
|
ProcIds = pred_info_all_procids(PredInfo),
|
|
hlds_pred.in_in_unification_proc_id(ProcId),
|
|
ProcIds = [ProcId]
|
|
;
|
|
% We dump unification and other compiler-generated special
|
|
% predicates if suboption 'U' is on. We don't need that
|
|
% information to understand how the program has been
|
|
% transformed.
|
|
not string.contains_char(DumpOptions, 'U'),
|
|
is_unify_index_or_compare_pred(PredInfo)
|
|
)
|
|
then
|
|
true
|
|
else
|
|
write_pred(Info, Stream, Lang, ModuleInfo, PredId, PredInfo, !IO)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Write out dependency information.
|
|
%
|
|
|
|
:- pred write_dependency_info(hlds_out_info::in, io.text_output_stream::in,
|
|
module_info::in, hlds_dependency_info::in, io::di, io::uo) is det.
|
|
|
|
write_dependency_info(_Info, Stream, ModuleInfo, DependencyInfo, !IO) :-
|
|
io.write_string(Stream, "% Dependency graph\n\n", !IO),
|
|
Graph = dependency_info_get_graph(DependencyInfo),
|
|
digraph.traverse(Graph,
|
|
write_dep_graph_node(Stream, ModuleInfo),
|
|
write_dep_graph_edge(Stream, ModuleInfo), !IO),
|
|
|
|
% If needed, this code can be used to check the raw behavior
|
|
% of digraph operations.
|
|
%
|
|
% ( if tsort(Graph, TSort) then
|
|
% write_indent(Stream, Indent, !IO),
|
|
% io.write_string(Stream, "\n% TSORT ordering\n\n", !IO),
|
|
% list.foldl(write_dependency_proc(Indent, "", ModuleInfo), TSort, !IO)
|
|
% else
|
|
% io.write_string(Stream, "\n% NO TSORT ordering\n\n", !IO)
|
|
% ),
|
|
%
|
|
% write_indent(Stream, Indent, !IO),
|
|
% io.write_string(Stream, "\n% ATSORT ordering\n\n", !IO),
|
|
% AtSort = digraph.atsort(Graph),
|
|
% list.foldl(write_dependency_scc(Indent, ModuleInfo), AtSort, !IO),
|
|
|
|
io.write_string(Stream, "\n% Bottom up dependency sccs\n\n", !IO),
|
|
Ordering = dependency_info_get_bottom_up_sccs(DependencyInfo),
|
|
list.foldl(write_dependency_scc(Stream, ModuleInfo), Ordering, !IO).
|
|
|
|
:- pred write_dep_graph_node(io.text_output_stream::in, module_info::in,
|
|
pred_proc_id::in, io::di, io::uo) is det.
|
|
|
|
write_dep_graph_node(Stream, ModuleInfo, Proc, !IO) :-
|
|
write_dependency_proc(Stream, "calls from ", ModuleInfo, Proc, !IO).
|
|
|
|
:- pred write_dep_graph_edge(io.text_output_stream::in, module_info::in,
|
|
pred_proc_id::in, pred_proc_id::in, io::di, io::uo) is det.
|
|
|
|
write_dep_graph_edge(Stream, ModuleInfo, _ParentProc, ChildProc, !IO) :-
|
|
write_dependency_proc(Stream, " to ", ModuleInfo, ChildProc, !IO).
|
|
|
|
:- pred write_dependency_scc(io.text_output_stream::in, module_info::in,
|
|
scc::in, io::di, io::uo) is det.
|
|
|
|
write_dependency_scc(Stream, ModuleInfo, SCC, !IO) :-
|
|
io.write_string(Stream, "% SCC\n", !IO),
|
|
set.foldl(write_dependency_proc(Stream, " ", ModuleInfo), SCC, !IO).
|
|
|
|
:- pred write_dependency_proc(io.text_output_stream::in, string::in,
|
|
module_info::in, pred_proc_id::in, io::di, io::uo) is det.
|
|
|
|
write_dependency_proc(Stream, Prefix, ModuleInfo, PredProcId, !IO) :-
|
|
PredProcId = proc(PredId, ProcId),
|
|
Pieces = describe_one_proc_name(ModuleInfo,
|
|
should_not_module_qualify, PredProcId),
|
|
Desc = error_pieces_to_string(Pieces),
|
|
|
|
io.format(Stream, "%% %spred %d proc %d, %s\n",
|
|
[s(Prefix), i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId)),
|
|
s(Desc)], !IO).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.hlds_out.hlds_out_module.
|
|
%---------------------------------------------------------------------------%
|