mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-05-01 01:04:43 +00:00
5f50259d16
Right now, most parts of the compiler write to the "current output stream".
This was a pragmatic choice at the time, but has not aged well. The problem
is that the answer to the question "where is the current output stream going?"
is not obvious in *all* places in the compiler (although it is obvious in
most). When using such implicit streams, finding where the output is going
to in a given predicate requires inspecting not just the ancestors of that
predicate, but also all their older siblings (since any of them could have
changed the current stream), *including* their entire call trees. This is
usually an infeasible task. By constrast, if we explicitly pass streams
to all output operations, we need only follow the places where the variable
representing that stream is bound, which the mode system makes easy.
This diff switches large parts of the compiler over to doing output only
to explicitly passed streams, never to the implicit "current output stream".
The parts it switches over are the parts that rely to a significant degree
on the innermost change, which is to the "output" typeclass in
parse_tree_out_info.m. This is the part that has to be switched over to
explicit streams first, because (a) many modules such as mercury_to_mercury.m
rely on the output typeclass, and (b) most other modules that do output
call predicates in these modules. Starting anywhere else would be like
building a skyscraper starting at the top.
This typeclass, output(U), has two instances: output(io), and output(string),
so you could output either to the current output stream, or to a string.
To allow the specification of the destination stream in the first case,
this diff changes the typeclass to output(S, U) with a functional dependency
from U to S, with the two instances being output(io.text_output_stream, io)
and output(unit, string). (The unit arg is ignored in the second case.)
There is a complication with the output typeclass method, add_list, that
outputs a list of items. The complication is that each item is output
by a predicate supplied by the caller, but the separator between the items
(usually a comma) is output by add_list itself. We don't want to give
callers of this method the opportunity to screw up by specifying (possibly
implicitly) two different output streams for these two purposes, so we want
(a) the caller to tell add_list where to put the separators, and then
(b) for add_list, not its caller, tell the user-supplied predicate what
stream to write to. This works only if the stream argument is just before
the di,uo pair of I/O state arguments, which differs from our usual practice
of passing the stream at or near the left edge of the argument list,
not near the right. The result of this complication is that two categories
of predicates that are and are not used to print items in a list differ
in where they put the stream in their argument lists. This makes it easy
to pass the stream in the wrong argument position if you call a predicate
without looking up its signature, and may require *changing* the argument
order when a predicate is used to print an item in a list for the first time.
A complete switch over to always passing the stream just before !IO
would fix this inconsistency, but is far to big a change to make all at once.
compiler/parse_tree_out_info.m:
Make the changes described above.
Add write_out_list, which is a variant of io.write_list specifically
designed to address the "complication" described above. It also has
the arguments in an order that is better suited for higher-order use.
Make the same change to argument order in the class method add_list
as well.
Almost all of the following changes consist of passing an extra stream
argument to output predicates. In some places, where I thought this would
aid readability, I replaced sequences of calls to output predicates
with a single io.format.
compiler/prog_out.m:
This module had many predicates that wrote things to the current output
stream. This diff adds versions of these predicates that take an
explicit stream argument.
If the originals are still needed after the changes to the other modules,
keep them, but add "_to_cur_stream" to the end of their names.
Otherwise, delete them. (Many of the changes below replace
write_xyz(..., !IO) with io.write_string(Stream, xyz_to_string(...), !IO),
especially when write_xyz did nothing except call xyz_to_string
and wrote out the result.)
compiler/c_util.m:
Add either an explicit stream argument to the argument list, or a
"_current_stream" suffix to the name, of every predicate defined
in this module that does output.
Add a new predicate to print out the block comment containing
input for mkinit. This factors out common code in the LLDS and MLDS
backends.
compiler/name_mangle.m:
Delete all predicates that used to write to the current output stream,
after replacing them if necessary with functions that return a string,
which the caller can print to wherever it wants. (The "if necessary"
part is there because some of the "replacement" functions already
existed.)
When converting a proc_label to a string, *always* require the caller
to say whether the label prefix should be added to the string,
instead of silently assuming "yes, add it", as calls to one of the old,
now deleted predicates had it.
compiler/file_util.m:
Add output_to_file_stream, a version of output_to_file which
simply passes the output file stream it opens to the predicate
that is intended to define the contents of the newly created or
updated file. The existing output_to_file, which instead sets
and resets the current output stream around the equivalent
predicate call, is still needed e.g. by the MLDS backend,
but hopefully for not too long.
compiler/mercury_to_mercury.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_term.m:
compiler/parse_tree_out_type_repn.m:
Change the code writing out parse trees to explicitly pass a stream
to every predicate that does output.
In some places, this allows us to avoid changing the identity
of the current output stream.
compiler/hlds_out.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
Change the code writing out HLDS code to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because these modules call many of the output
predicates in the parse tree package.)
In hlds_out_util.m, delete some write_to_xyz(...) predicates that wrote
the result of xyz_to_string(...) to the current output stream.
Replace calls to the deleted predicates with calls to io.write_string
with the string being written being computed by xyz_to_string.
Add a predicate to hlds_out_util.m that outputs a comment containing
the current context, if it is valid. This factors out code that used
to be common to several of the other modules.
In a few places in hlds_out_module.m, the new code generates a
slighly different set of blank lines, but this should not be a problem.
compiler/layout_out.m:
compiler/llds_out_code_addr.m:
compiler/llds_out_data.m:
compiler/llds_out_file.m:
compiler/llds_out_global.m:
compiler/llds_out_instr.m:
compiler/llds_out_util.m:
compiler/opt_debug.m:
compiler/rtti_out.m:
Change the code writing out the LLDS to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because layout_out.m and rtti_out.m call
many of the output predicates in the parse tree package,
and through them, the rest of the LLDS backend is affected as well.)
compiler/make.module_dep_file.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_middle_passes.m:
Replace code that sets and resets the current output stream
with code that simply passes an explicit output stream to a
predicate that now *takes* an explicit stream as an argument.
compiler/accumulator.m:
compiler/add_clause.m:
compiler/code_gen.m:
compiler/code_loc_dep.m:
compiler/cse_detection.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/det_analysis.m:
compiler/error_msg_inst.m:
compiler/export.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/ite_gen.m:
compiler/lco.m:
compiler/liveness.m:
compiler/lp_rational.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_global.m:
compiler/mode_debug.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/optimize.m:
compiler/passes_aux.m:
compiler/pd_debug.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/prog_ctgc.m:
compiler/push_goals_together.m:
compiler/rat.m:
compiler/recompilation.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/rtti.m:
compiler/saved_vars.m:
compiler/simplify_goal_conj.m:
compiler/stack_opt.m:
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/superhomogeneous.m:
compiler/term_constr_build.m:
compiler/term_constr_data.m:
compiler/term_constr_fixpoint.m:
compiler/term_constr_pass2.m:
compiler/term_constr_util.m:
compiler/tupling.m:
compiler/type_assign.m:
compiler/unneeded_code.m:
compiler/write_deps_file.m:
Conform to the changes above, mostly by passing streams explicitly.
compiler/hlds_dependency_graph.m:
Conform to the changes above, mostly by passing streams explicitly.
Move a predicate's definition next it only use.
compiler/Mercury.options:
Specify --warn-implicit-stream-calls for all the modules in which
this diff has replaced all implicit streams with explicit streams.
(Unfortunately, debugging this diff has shown that --warn-implicit-
stream-calls detects only *some*, and not *all*, uses of implicit
streams.)
library/term_io.m:
Fix documentation.
1584 lines
61 KiB
Mathematica
1584 lines
61 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2001-2012 University of Melbourne.
|
|
% Copyright (C) 2015 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: recompilation.usage.m.
|
|
% Main author: stayl.
|
|
%
|
|
% Write the file recording which imported items were used by a compilation.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module recompilation.usage.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.module_imports.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module io.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module set.
|
|
|
|
% The resolved_used_items records the possible matches for a program item.
|
|
% It is used by recompilation_check.m to work out whether a new item
|
|
% could cause ambiguity with an item which was used during a compilation.
|
|
:- type resolved_used_items ==
|
|
item_id_set(simple_item_set, resolved_pred_or_func_set,
|
|
resolved_functor_set).
|
|
|
|
:- type resolved_pred_or_func_set ==
|
|
resolved_item_set(set(pair(pred_id, module_name))).
|
|
:- type resolved_pred_or_func_map ==
|
|
resolved_item_map(set(pair(pred_id, module_name))).
|
|
|
|
% A resolved_functor_set records all possible matches
|
|
% for each functor application.
|
|
:- type resolved_functor_set == resolved_item_set(set(resolved_functor)).
|
|
:- type resolved_functor_map == resolved_item_map(set(resolved_functor)).
|
|
|
|
:- type resolved_item_set(T) == map(string, resolved_item_list(T)).
|
|
|
|
% The list is sorted on arity. This is useful because when determining
|
|
% whether there is an ambiguity we need to test a predicate or function
|
|
% against all used functors with equal or lower arity.
|
|
:- type resolved_item_list(T) == assoc_list(arity, resolved_item_map(T)).
|
|
|
|
:- type resolved_item_map(T) == map(module_qualifier, T).
|
|
|
|
:- type resolved_functor
|
|
---> resolved_functor_pred_or_func(
|
|
pred_id,
|
|
module_name,
|
|
pred_or_func,
|
|
arity % The actual arity of the predicate or function
|
|
)
|
|
; resolved_functor_constructor(
|
|
item_name % type_ctor
|
|
)
|
|
; resolved_functor_field(
|
|
item_name, % type_ctor
|
|
item_name % cons_id
|
|
).
|
|
|
|
:- pred write_usage_file(module_info::in, set(module_name)::in,
|
|
maybe(module_timestamp_map)::in, io::di, io::uo) is det.
|
|
|
|
% Changes which modify the format of the `.used' files will increment
|
|
% this number. recompilation_check.m should recompile if the version number
|
|
% is out of date.
|
|
%
|
|
:- func usage_file_version_number = int.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_class.
|
|
:- import_module hlds.hlds_cons.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module libs.
|
|
:- import_module libs.file_util.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module libs.timestamp.
|
|
:- import_module mdbcomp.builtin_modules.
|
|
:- import_module parse_tree.file_kind.
|
|
:- import_module parse_tree.file_names.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.prog_item.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module recompilation.version.
|
|
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module one_or_more.
|
|
:- import_module queue.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
write_usage_file(ModuleInfo, NestedSubModules, MaybeTimestampMap, !IO) :-
|
|
module_info_get_maybe_recompilation_info(ModuleInfo, MaybeRecompInfo),
|
|
( if
|
|
MaybeRecompInfo = yes(RecompInfo),
|
|
MaybeTimestampMap = yes(TimestampMap)
|
|
then
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, verbose, Verbose),
|
|
maybe_write_string(Verbose,
|
|
"% Writing recompilation compilation dependency information\n",
|
|
!IO),
|
|
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
module_name_to_file_name(Globals, $pred, do_create_dirs,
|
|
ext_other(other_ext(".used")), ModuleName, FileName, !IO),
|
|
io.open_output(FileName, FileResult, !IO),
|
|
(
|
|
FileResult = ok(FileStream),
|
|
write_usage_file_2(FileStream, ModuleInfo,
|
|
set.to_sorted_list(NestedSubModules), RecompInfo, TimestampMap,
|
|
!IO),
|
|
io.close_output(FileStream, !IO)
|
|
;
|
|
FileResult = error(IOError),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.output_stream(CurStream, !IO),
|
|
io.format(CurStream, "\nError opening `%s' for output: %s.\n",
|
|
[s(FileName), s(IOErrorMessage)], !IO),
|
|
io.set_exit_status(1, !IO)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred write_usage_file_2(io.text_output_stream::in, module_info::in,
|
|
list(module_name)::in, recompilation_info::in,
|
|
module_timestamp_map::in, io::di, io::uo) is det.
|
|
|
|
write_usage_file_2(Stream, ModuleInfo, NestedSubModules, RecompInfo,
|
|
TimestampMap, !IO) :-
|
|
io.write_int(Stream, usage_file_version_number, !IO),
|
|
io.write_string(Stream, ",", !IO),
|
|
io.write_int(Stream, version_numbers_version_number, !IO),
|
|
io.write_string(Stream, ".\n\n", !IO),
|
|
|
|
module_info_get_name(ModuleInfo, ThisModuleName),
|
|
map.lookup(TimestampMap, ThisModuleName,
|
|
module_timestamp(_, ThisModuleTimestamp, _)),
|
|
io.write_string(Stream, "(", !IO),
|
|
mercury_output_bracketed_sym_name(ThisModuleName, Stream, !IO),
|
|
io.write_string(Stream, ", "".m"", ", !IO),
|
|
write_version_number(Stream, ThisModuleTimestamp, !IO),
|
|
io.write_string(Stream, ").\n\n", !IO),
|
|
|
|
(
|
|
NestedSubModules = [],
|
|
io.write_string(Stream, "sub_modules.\n\n", !IO)
|
|
;
|
|
NestedSubModules = [_ | _],
|
|
io.write_string(Stream, "sub_modules(", !IO),
|
|
write_out_list(mercury_output_bracketed_sym_name, ", ",
|
|
NestedSubModules, Stream, !IO),
|
|
io.write_string(Stream, ").\n\n", !IO)
|
|
),
|
|
|
|
UsedItems = RecompInfo ^ recomp_used_items,
|
|
find_all_used_imported_items(ModuleInfo,
|
|
UsedItems, RecompInfo ^ recomp_dependencies, ResolvedUsedItems,
|
|
UsedClasses, ImportedItems, ModuleInstances),
|
|
|
|
( if UsedItems = init_used_items then
|
|
io.write_string(Stream, "used_items.\n", !IO)
|
|
else
|
|
io.write_string(Stream, "used_items(\n\t", !IO),
|
|
some [!WriteComma] (
|
|
!:WriteComma = no,
|
|
write_simple_item_matches(Stream, type_abstract_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_simple_item_matches(Stream, type_body_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_simple_item_matches(Stream, mode_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_simple_item_matches(Stream, inst_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_simple_item_matches(Stream, typeclass_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_pred_or_func_matches(Stream, predicate_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_pred_or_func_matches(Stream, function_item,
|
|
ResolvedUsedItems, !WriteComma, !IO),
|
|
write_functor_matches(Stream, ResolvedUsedItems ^ functors,
|
|
!WriteComma, !IO),
|
|
_ = !.WriteComma
|
|
),
|
|
io.write_string(Stream, "\n).\n\n", !IO)
|
|
),
|
|
|
|
( if set.is_empty(UsedClasses) then
|
|
io.write_string(Stream, "used_classes.\n", !IO)
|
|
else
|
|
io.write_string(Stream, "used_classes(", !IO),
|
|
write_out_list(write_classname_and_arity, ", ",
|
|
set.to_sorted_list(UsedClasses), Stream, !IO),
|
|
io.write_string(Stream, ").\n", !IO)
|
|
),
|
|
|
|
map.foldl(
|
|
write_module_name_and_used_items(Stream, RecompInfo, TimestampMap,
|
|
ModuleInstances),
|
|
ImportedItems, !IO),
|
|
% recompilation_check.m checks for this item when reading in the `.used'
|
|
% file to make sure the earlier compilation wasn't interrupted in the
|
|
% middle of writing the file.
|
|
io.nl(Stream, !IO),
|
|
io.write_string(Stream, "done.\n", !IO).
|
|
|
|
:- pred write_module_name_and_used_items(io.text_output_stream::in,
|
|
recompilation_info::in, module_timestamp_map::in,
|
|
map(module_name, set(item_name))::in, module_name::in,
|
|
item_id_set(set(pair(string, arity)))::in, io::di, io::uo) is det.
|
|
|
|
write_module_name_and_used_items(Stream, RecompInfo, TimestampMap,
|
|
ModuleInstances, ModuleName, ModuleUsedItems, !IO) :-
|
|
io.nl(Stream, !IO),
|
|
io.write_string(Stream, "(", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, Stream, !IO),
|
|
io.write_string(Stream, ", """, !IO),
|
|
map.lookup(TimestampMap, ModuleName,
|
|
module_timestamp(FileKind, ModuleTimestamp, RecompNeedQual)),
|
|
file_kind_to_extension(FileKind, ExtStr, _Ext),
|
|
io.write_string(Stream, ExtStr, !IO),
|
|
io.write_string(Stream, """, ", !IO),
|
|
write_version_number(Stream, ModuleTimestamp, !IO),
|
|
% This must be kept in sync with parse_module_timestamp in
|
|
% recompilation.check.m.
|
|
(
|
|
RecompNeedQual = recomp_avail_src,
|
|
io.write_string(Stream, ", src", !IO)
|
|
;
|
|
RecompNeedQual = recomp_avail_int_use,
|
|
% We used to output just ", used".
|
|
io.write_string(Stream, ", int_used", !IO)
|
|
;
|
|
RecompNeedQual = recomp_avail_imp_use,
|
|
io.write_string(Stream, ", imp_used", !IO)
|
|
;
|
|
RecompNeedQual = recomp_avail_int_import,
|
|
% We used to output nothing.
|
|
io.write_string(Stream, ", int_imported", !IO)
|
|
;
|
|
RecompNeedQual = recomp_avail_imp_import,
|
|
% We used to output nothing.
|
|
io.write_string(Stream, ", imp_imported", !IO)
|
|
;
|
|
RecompNeedQual = recomp_avail_int_use_imp_import,
|
|
io.write_string(Stream, ", int_used_imp_imported", !IO)
|
|
),
|
|
io.write_string(Stream, ")", !IO),
|
|
( if
|
|
% XXX We don't yet record all uses of items from these modules
|
|
% in polymorphism.m, etc.
|
|
not any_mercury_builtin_module(ModuleName),
|
|
map.search(RecompInfo ^ recomp_version_numbers, ModuleName,
|
|
ModuleVersions)
|
|
then
|
|
% Select out from the version numbers of all items in the imported
|
|
% module the ones which are used.
|
|
ModuleVersions = version_numbers(ModuleItemVersions,
|
|
ModuleInstanceVersions),
|
|
ModuleUsedItemVersions = map_ids(
|
|
( func(ItemType, Ids0) = Ids :-
|
|
ModuleItemNames = extract_ids(ModuleUsedItems, ItemType),
|
|
map.select(Ids0, ModuleItemNames, Ids)
|
|
),
|
|
ModuleItemVersions, map.init),
|
|
( if map.search(ModuleInstances, ModuleName, ModuleUsedInstances) then
|
|
map.select(ModuleInstanceVersions, ModuleUsedInstances,
|
|
ModuleUsedInstanceVersions)
|
|
else
|
|
map.init(ModuleUsedInstanceVersions)
|
|
),
|
|
|
|
io.write_string(Stream, " => ", !IO),
|
|
ModuleUsedVersionNumbers =
|
|
version_numbers(ModuleUsedItemVersions,
|
|
ModuleUsedInstanceVersions),
|
|
write_version_numbers(Stream, ModuleUsedVersionNumbers, !IO),
|
|
io.write_string(Stream, ".\n", !IO)
|
|
else
|
|
% If we don't have version numbers for a module we just recompile
|
|
% if the interface file's timestamp changes.
|
|
io.write_string(Stream, ".\n", !IO)
|
|
).
|
|
|
|
:- pred write_classname_and_arity(item_name::in, io.text_output_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_classname_and_arity(item_name(ClassName, ClassArity), Stream, !IO) :-
|
|
mercury_output_bracketed_sym_name(ClassName, Stream, !IO),
|
|
io.write_string(Stream, "/", !IO),
|
|
io.write_int(Stream, ClassArity, !IO).
|
|
|
|
:- pred write_comma_if_needed(io.text_output_stream::in,
|
|
bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_comma_if_needed(Stream, !WriteComma, !IO) :-
|
|
(
|
|
!.WriteComma = yes,
|
|
io.write_string(Stream, ",\n\t", !IO)
|
|
;
|
|
!.WriteComma = no
|
|
),
|
|
!:WriteComma = yes.
|
|
|
|
:- pred write_simple_item_matches(io.text_output_stream::in,
|
|
item_type::in(simple_item), resolved_used_items::in,
|
|
bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches(Stream, ItemType, UsedItems, !WriteComma, !IO) :-
|
|
Ids = extract_simple_item_set(UsedItems, ItemType),
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(Stream, !WriteComma, !IO),
|
|
write_simple_item_matches_2(Stream, ItemType, Ids, !IO)
|
|
).
|
|
|
|
:- pred write_simple_item_matches_2(io.text_output_stream::in,
|
|
item_type::in, simple_item_set::in, io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_2(Stream, ItemType, ItemSet, !IO) :-
|
|
string_to_item_type(ItemTypeStr, ItemType),
|
|
io.write_string(Stream, ItemTypeStr, !IO),
|
|
io.write_string(Stream, "(\n\t\t", !IO),
|
|
map.to_assoc_list(ItemSet, ItemList),
|
|
write_out_list(write_simple_item_matches_3, ",\n\t\t", ItemList,
|
|
Stream, !IO),
|
|
io.write_string(Stream, "\n\t)", !IO).
|
|
|
|
:- pred write_simple_item_matches_3(
|
|
pair(pair(string, arity), map(module_qualifier, module_name))::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_3((Name - Arity) - Matches, Stream, !IO) :-
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
unqualified(Name), Stream, !IO),
|
|
io.write_string(Stream, "/", !IO),
|
|
io.write_int(Stream, Arity, !IO),
|
|
io.write_string(Stream, " - (", !IO),
|
|
map.to_assoc_list(Matches, MatchList),
|
|
write_out_list(write_simple_item_matches_4, ", ", MatchList, Stream, !IO),
|
|
io.write_string(Stream, ")", !IO).
|
|
|
|
:- pred write_simple_item_matches_4(pair(module_qualifier, module_name)::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_4(Qualifier - ModuleName, Stream, !IO) :-
|
|
mercury_output_bracketed_sym_name(Qualifier, Stream, !IO),
|
|
( if Qualifier = ModuleName then
|
|
true
|
|
else
|
|
io.write_string(Stream, " => ", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, Stream, !IO)
|
|
).
|
|
|
|
:- pred write_pred_or_func_matches(io.text_output_stream::in,
|
|
item_type::in(pred_or_func_item), resolved_used_items::in,
|
|
bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches(Stream, ItemType, UsedItems, !WriteComma, !IO) :-
|
|
Ids = extract_pred_or_func_set(UsedItems, ItemType),
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(Stream, !WriteComma, !IO),
|
|
write_pred_or_func_matches_2(ItemType, Ids, Stream, !IO)
|
|
).
|
|
|
|
:- pred write_pred_or_func_matches_2(item_type::in(pred_or_func_item),
|
|
resolved_pred_or_func_set::in, io.text_output_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches_2(ItemType, ItemSet, Stream, !IO) :-
|
|
write_resolved_item_set(ItemType, ItemSet, write_pred_or_func_matches_3,
|
|
Stream, !IO).
|
|
|
|
:- pred write_pred_or_func_matches_3(
|
|
pair(sym_name, set(pair(pred_id, sym_name)))::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches_3(Qualifier - PredIdModuleNames, Stream, !IO) :-
|
|
ModuleNames = assoc_list.values(set.to_sorted_list(PredIdModuleNames)),
|
|
mercury_output_bracketed_sym_name(Qualifier, Stream, !IO),
|
|
( if ModuleNames = [Qualifier] then
|
|
true
|
|
else
|
|
io.write_string(Stream, " => (", !IO),
|
|
write_out_list(mercury_output_bracketed_sym_name, ", ", ModuleNames,
|
|
Stream, !IO),
|
|
io.write_string(Stream, ")", !IO)
|
|
).
|
|
|
|
:- pred write_functor_matches(io.text_output_stream::in,
|
|
resolved_functor_set::in, bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_functor_matches(Stream, Ids, !WriteComma, !IO) :-
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(Stream, !WriteComma, !IO),
|
|
write_resolved_item_set(functor_item, Ids, write_functor_matches_2,
|
|
Stream, !IO)
|
|
).
|
|
|
|
:- pred write_functor_matches_2(pair(sym_name, set(resolved_functor))::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_functor_matches_2(Qualifier - MatchingCtors, Stream, !IO) :-
|
|
mercury_output_bracketed_sym_name(Qualifier, Stream, !IO),
|
|
io.write_string(Stream, " => (", !IO),
|
|
write_out_list(write_resolved_functor, ", ",
|
|
set.to_sorted_list(MatchingCtors), Stream, !IO),
|
|
io.write_string(Stream, ")", !IO).
|
|
|
|
:- type write_resolved_item(T) ==
|
|
pred(pair(module_qualifier, T), io.text_output_stream, io, io).
|
|
:- inst write_resolved_item == (pred(in, in, di, uo) is det).
|
|
|
|
:- pred write_resolved_item_set(item_type::in, resolved_item_set(T)::in,
|
|
write_resolved_item(T)::in(write_resolved_item),
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_resolved_item_set(ItemType, ItemSet, WriteMatches, Stream, !IO) :-
|
|
string_to_item_type(ItemTypeStr, ItemType),
|
|
io.write_string(Stream, ItemTypeStr, !IO),
|
|
io.write_string(Stream, "(\n\t\t", !IO),
|
|
map.to_assoc_list(ItemSet, ItemList),
|
|
write_out_list(write_resolved_item_set_2(WriteMatches), ",\n\t\t",
|
|
ItemList, Stream, !IO),
|
|
io.write_string(Stream, "\n\t)", !IO).
|
|
|
|
:- pred write_resolved_item_set_2(
|
|
write_resolved_item(T)::in(write_resolved_item),
|
|
pair(string, list(pair(int, map(sym_name, T))))::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_resolved_item_set_2(WriteMatches, Name - MatchesAL, Stream, !IO) :-
|
|
mercury_output_bracketed_sym_name(unqualified(Name), Stream, !IO),
|
|
io.write_string(Stream, " - (", !IO),
|
|
write_out_list(write_resolved_item_set_3(WriteMatches), ",\n\t\t\t",
|
|
MatchesAL, Stream, !IO),
|
|
io.write_string(Stream, ")", !IO).
|
|
|
|
:- pred write_resolved_item_set_3(
|
|
write_resolved_item(T)::in(write_resolved_item),
|
|
pair(int, map(sym_name, T))::in, io.text_output_stream::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_resolved_item_set_3(WriteMatches, Arity - Matches, Stream, !IO) :-
|
|
io.write_int(Stream, Arity, !IO),
|
|
io.write_string(Stream, " - (", !IO),
|
|
map.to_assoc_list(Matches, MatchList),
|
|
write_out_list(WriteMatches, ",\n\t\t\t\t", MatchList, Stream, !IO),
|
|
io.write_string(Stream, ")", !IO).
|
|
|
|
:- pred write_resolved_functor(resolved_functor::in,
|
|
io.text_output_stream::in, io::di, io::uo) is det.
|
|
|
|
write_resolved_functor(ResolvedFunctor, Stream, !IO) :-
|
|
(
|
|
ResolvedFunctor = resolved_functor_pred_or_func(_, ModuleName,
|
|
PredOrFunc, Arity),
|
|
io.write_string(Stream, pred_or_func_to_full_str(PredOrFunc), !IO),
|
|
io.write_string(Stream, "(", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, Stream, !IO),
|
|
io.write_string(Stream, ", ", !IO),
|
|
io.write_int(Stream, Arity, !IO),
|
|
io.write_string(Stream, ")", !IO)
|
|
;
|
|
ResolvedFunctor = resolved_functor_constructor(ItemName),
|
|
ItemName = item_name(TypeName, Arity),
|
|
io.write_string(Stream, "ctor(", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
TypeName, Stream, !IO),
|
|
io.write_string(Stream, "/", !IO),
|
|
io.write_int(Stream, Arity, !IO),
|
|
io.write_string(Stream, ")", !IO)
|
|
;
|
|
ResolvedFunctor = resolved_functor_field(TypeItemName, ConsItemName),
|
|
TypeItemName = item_name(TypeName, TypeArity),
|
|
ConsItemName = item_name(ConsName, ConsArity),
|
|
io.write_string(Stream, "field(", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
TypeName, Stream, !IO),
|
|
io.write_string(Stream, "/", !IO),
|
|
io.write_int(Stream, TypeArity, !IO),
|
|
io.write_string(Stream, ", ", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
ConsName, Stream, !IO),
|
|
io.write_string(Stream, "/", !IO),
|
|
io.write_int(Stream, ConsArity, !IO),
|
|
io.write_string(Stream, ")", !IO)
|
|
).
|
|
|
|
usage_file_version_number = 2.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type recompilation_usage_info
|
|
---> recompilation_usage_info(
|
|
module_info :: module_info,
|
|
item_queue :: queue(item_id),
|
|
imported_items :: imported_items,
|
|
module_instances :: map(module_name, set(item_name)),
|
|
% For each module, the used typeclasses for
|
|
% which the module contains an instance.
|
|
|
|
dependencies :: map(item_id, set(item_id)),
|
|
used_items :: resolved_used_items,
|
|
used_typeclasses :: set(item_name)
|
|
).
|
|
|
|
:- type imported_items == map(module_name, module_imported_items).
|
|
|
|
% The constructors set should always be empty -
|
|
% constructors are never imported separately.
|
|
:- type module_imported_items == item_id_set(imported_item_set).
|
|
|
|
:- type imported_item_set == set(pair(string, arity)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred insert_into_imported_items_map(module_name::in,
|
|
imported_items::in, imported_items::out) is det.
|
|
|
|
insert_into_imported_items_map(VisibleModule, !ImportedItemsMap) :-
|
|
ModuleItems = init_item_id_set(set.init),
|
|
|
|
% Use map.set rather than map.det_insert as this routine may be called
|
|
% multiple times with the same VisibleModule, for example if the module
|
|
% is both imported and an ancestor module.
|
|
map.set(VisibleModule, ModuleItems, !ImportedItemsMap).
|
|
|
|
% Go over the set of imported items found to be used and
|
|
% find the transitive closure of the imported items they use.
|
|
%
|
|
:- pred find_all_used_imported_items(module_info::in,
|
|
used_items::in, map(item_id, set(item_id))::in,
|
|
resolved_used_items::out, set(item_name)::out, imported_items::out,
|
|
map(module_name, set(item_name))::out) is det.
|
|
|
|
find_all_used_imported_items(ModuleInfo,
|
|
UsedItems, Dependencies, ResolvedUsedItems, UsedTypeClasses,
|
|
ImportedItems, ModuleInstances) :-
|
|
% We need to make sure each visible module has an entry in the `.used'
|
|
% file, even if nothing was used from it. This will cause
|
|
% recompilation_check.m to check for new items causing ambiguity
|
|
% when the interface of the module changes.
|
|
module_info_get_visible_modules(ModuleInfo, AllVisibleModules),
|
|
module_info_get_name(ModuleInfo, ModuleName),
|
|
set.delete(ModuleName, AllVisibleModules, ImportedVisibleModules),
|
|
|
|
map.init(ImportedItems0),
|
|
set.foldl(insert_into_imported_items_map, ImportedVisibleModules,
|
|
ImportedItems0, ImportedItems1),
|
|
|
|
queue.init(ItemsToProcess0),
|
|
map.init(ModuleUsedClasses),
|
|
set.init(UsedClasses0),
|
|
|
|
UsedItems = item_id_set(Types, TypeBodies, Modes, Insts, Classes,
|
|
_, _, _, _, _),
|
|
map.init(ResolvedCtors),
|
|
map.init(ResolvedPreds),
|
|
map.init(ResolvedFuncs),
|
|
map.init(ResolvedMutables),
|
|
map.init(ResolvedForeignProcs),
|
|
ResolvedUsedItems0 = item_id_set(Types, TypeBodies, Modes, Insts,
|
|
Classes, ResolvedCtors, ResolvedPreds, ResolvedFuncs,
|
|
ResolvedMutables, ResolvedForeignProcs),
|
|
|
|
Info0 = recompilation_usage_info(ModuleInfo, ItemsToProcess0,
|
|
ImportedItems1, ModuleUsedClasses, Dependencies,
|
|
ResolvedUsedItems0, UsedClasses0),
|
|
|
|
find_all_used_imported_items_2(UsedItems, Info0, Info),
|
|
|
|
ImportedItems = Info ^ imported_items,
|
|
ModuleInstances = Info ^ module_instances,
|
|
UsedTypeClasses = Info ^ used_typeclasses,
|
|
ResolvedUsedItems = Info ^ used_items.
|
|
|
|
:- pred find_all_used_imported_items_2(used_items::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_all_used_imported_items_2(UsedItems, !Info) :-
|
|
% Find items used by imported instances for local classes.
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_instance_table(ModuleInfo, Instances),
|
|
map.foldl(find_items_used_by_instances, Instances, !Info),
|
|
|
|
Predicates = UsedItems ^ predicates,
|
|
find_items_used_by_preds(pf_predicate, Predicates, !Info),
|
|
|
|
Functions = UsedItems ^ functions,
|
|
find_items_used_by_preds(pf_function, Functions, !Info),
|
|
|
|
Constructors = UsedItems ^ functors,
|
|
find_items_used_by_functors(Constructors, !Info),
|
|
|
|
Types = UsedItems ^ types,
|
|
find_items_used_by_simple_item_set(type_abstract_item, Types, !Info),
|
|
|
|
TypeBodies = UsedItems ^ type_bodies,
|
|
find_items_used_by_simple_item_set(type_body_item, TypeBodies, !Info),
|
|
|
|
Modes = UsedItems ^ modes,
|
|
find_items_used_by_simple_item_set(mode_item, Modes, !Info),
|
|
|
|
Classes = UsedItems ^ typeclasses,
|
|
find_items_used_by_simple_item_set(typeclass_item, Classes, !Info),
|
|
|
|
Insts = UsedItems ^ insts,
|
|
find_items_used_by_simple_item_set(inst_item, Insts, !Info),
|
|
|
|
process_imported_item_queue(!Info).
|
|
|
|
:- pred process_imported_item_queue(
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
process_imported_item_queue(!Info) :-
|
|
Queue0 = !.Info ^ item_queue,
|
|
!Info ^ item_queue := queue.init,
|
|
process_imported_item_queue_2(Queue0, !Info),
|
|
Queue = !.Info ^ item_queue,
|
|
( if queue.is_empty(Queue) then
|
|
true
|
|
else
|
|
disable_warning [suspicious_recursion] (
|
|
process_imported_item_queue(!Info)
|
|
)
|
|
).
|
|
|
|
:- pred process_imported_item_queue_2(
|
|
queue(item_id)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
process_imported_item_queue_2(!.Queue, !Info) :-
|
|
( if queue.get(Item, !Queue) then
|
|
Item = item_id(ItemType, ItemId),
|
|
find_items_used_by_item(ItemType, ItemId, !Info),
|
|
disable_warning [suspicious_recursion] (
|
|
process_imported_item_queue_2(!.Queue, !Info)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred record_used_pred_or_func(pred_or_func::in, item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_used_pred_or_func(PredOrFunc, Id, !Info) :-
|
|
ItemType = pred_or_func_to_item_type(PredOrFunc),
|
|
ItemSet0 = !.Info ^ used_items,
|
|
IdSet0 = extract_pred_or_func_set(ItemSet0, ItemType),
|
|
Id = item_name(SymName, Arity),
|
|
record_resolved_item(SymName, Arity,
|
|
do_record_used_pred_or_func(PredOrFunc),
|
|
IdSet0, IdSet, !Info),
|
|
update_pred_or_func_set(ItemType, IdSet, ItemSet0, ItemSet),
|
|
!Info ^ used_items := ItemSet.
|
|
|
|
:- pred do_record_used_pred_or_func(pred_or_func::in,
|
|
module_qualifier::in, sym_name::in, arity::in, bool::out,
|
|
resolved_pred_or_func_map::in, resolved_pred_or_func_map::out,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
do_record_used_pred_or_func(PredOrFunc, ModuleQualifier,
|
|
SymName, Arity, Recorded, !MatchingNames, !Info) :-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_predicate_table(ModuleInfo, PredTable),
|
|
adjust_func_arity(PredOrFunc, OrigArity, Arity),
|
|
predicate_table_lookup_pf_sym_arity(PredTable, may_be_partially_qualified,
|
|
PredOrFunc, SymName, OrigArity, MatchingPredIds),
|
|
(
|
|
MatchingPredIds = [_ | _],
|
|
Recorded = yes,
|
|
PredModules = set.list_to_set(list.map(
|
|
( func(PredId) = PredId - PredModule :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
PredModule = pred_info_module(PredInfo)
|
|
),
|
|
MatchingPredIds)),
|
|
map.det_insert(ModuleQualifier, PredModules, !MatchingNames),
|
|
Name = unqualify_name(SymName),
|
|
set.fold(find_items_used_by_pred(PredOrFunc, Name - Arity),
|
|
PredModules, !Info)
|
|
;
|
|
MatchingPredIds = [],
|
|
Recorded = no
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred record_used_functor(pair(sym_name, arity)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_used_functor(SymName - Arity, !Info) :-
|
|
ItemSet0 = !.Info ^ used_items,
|
|
IdSet0 = ItemSet0 ^ functors,
|
|
record_resolved_item(SymName, Arity, do_record_used_functor,
|
|
IdSet0, IdSet, !Info),
|
|
ItemSet = ItemSet0 ^ functors := IdSet,
|
|
!Info ^ used_items := ItemSet.
|
|
|
|
:- pred do_record_used_functor(module_qualifier::in,
|
|
sym_name::in, arity::in, bool::out, resolved_functor_map::in,
|
|
resolved_functor_map::out,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
do_record_used_functor(ModuleQualifier, SymName, Arity, Recorded,
|
|
!ResolvedCtorMap, !Info) :-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
|
|
find_matching_functors(ModuleInfo, SymName, Arity, MatchingCtors),
|
|
Name = unqualify_name(SymName),
|
|
set.fold(find_items_used_by_functor(Name, Arity), MatchingCtors, !Info),
|
|
|
|
( if set.is_empty(MatchingCtors) then
|
|
Recorded = no
|
|
else
|
|
Recorded = yes,
|
|
map.det_insert(ModuleQualifier, MatchingCtors, !ResolvedCtorMap)
|
|
).
|
|
|
|
:- pred find_matching_functors(module_info::in,
|
|
sym_name::in, arity::in, set(resolved_functor)::out) is det.
|
|
|
|
find_matching_functors(ModuleInfo, SymName, Arity, ResolvedConstructors) :-
|
|
% Is it a constructor.
|
|
module_info_get_cons_table(ModuleInfo, Ctors),
|
|
ConsId = cons(SymName, Arity, cons_id_dummy_type_ctor),
|
|
( if search_cons_table(Ctors, ConsId, ConsDefns0) then
|
|
ConsDefns1 = ConsDefns0
|
|
else
|
|
ConsDefns1 = []
|
|
),
|
|
( if
|
|
remove_new_prefix(SymName, SymNameMinusNew),
|
|
ConsIdMinusNew = cons(SymNameMinusNew, Arity, cons_id_dummy_type_ctor),
|
|
search_cons_table(Ctors, ConsIdMinusNew, ConsDefns2)
|
|
then
|
|
ConsDefns = ConsDefns1 ++ ConsDefns2
|
|
else
|
|
ConsDefns = ConsDefns1
|
|
),
|
|
MatchingConstructors =
|
|
list.map(
|
|
( func(ConsDefn) = Ctor :-
|
|
ConsDefn ^ cons_type_ctor = TypeCtor,
|
|
Ctor = resolved_functor_constructor(
|
|
type_ctor_to_item_name(TypeCtor))
|
|
),
|
|
ConsDefns),
|
|
|
|
% Is it a higher-order term or function call.
|
|
module_info_get_predicate_table(ModuleInfo, PredicateTable),
|
|
predicate_table_lookup_sym(PredicateTable,
|
|
may_be_partially_qualified, SymName, PredIds),
|
|
MatchingPreds = list.filter_map(
|
|
get_pred_or_func_ctors(ModuleInfo, SymName, Arity),
|
|
PredIds),
|
|
|
|
% Is it a field access function.
|
|
( if
|
|
is_field_access_function_name(ModuleInfo, SymName, Arity,
|
|
_, FieldName),
|
|
module_info_get_ctor_field_table(ModuleInfo, CtorFields),
|
|
map.search(CtorFields, FieldName, FieldDefns)
|
|
then
|
|
MatchingFields = list.map(
|
|
( func(FieldDefn) = FieldCtor :-
|
|
FieldDefn =
|
|
hlds_ctor_field_defn(_, _, TypeCtor, FieldConsId, _),
|
|
( if FieldConsId = cons(ConsName, ConsArity, _) then
|
|
FieldCtor = resolved_functor_field(
|
|
type_ctor_to_item_name(TypeCtor),
|
|
item_name(ConsName, ConsArity))
|
|
else
|
|
unexpected($pred, "weird cons_id in hlds_field_defn")
|
|
)
|
|
), FieldDefns)
|
|
else
|
|
MatchingFields = []
|
|
),
|
|
ResolvedConstructors = set.list_to_set(list.condense(
|
|
[MatchingConstructors, MatchingPreds, MatchingFields])).
|
|
|
|
:- func get_pred_or_func_ctors(module_info, sym_name,
|
|
arity, pred_id) = resolved_functor is semidet.
|
|
|
|
get_pred_or_func_ctors(ModuleInfo, _SymName, Arity, PredId) = ResolvedCtor :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
PredModule = pred_info_module(PredInfo),
|
|
PredArity = pred_info_orig_arity(PredInfo),
|
|
pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars),
|
|
adjust_func_arity(PredOrFunc, OrigArity, PredArity),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
OrigArity >= Arity,
|
|
% We don't support first-class polymorphism, so you can't take
|
|
% the address of an existentially quantified predicate.
|
|
PredExistQVars = []
|
|
;
|
|
PredOrFunc = pf_function,
|
|
OrigArity >= Arity,
|
|
% We don't support first-class polymorphism, so you can't take
|
|
% the address of an existentially quantified function. You can however
|
|
% call such a function, so long as you pass *all* the parameters.
|
|
( PredExistQVars = []
|
|
; OrigArity = Arity
|
|
)
|
|
),
|
|
ResolvedCtor = resolved_functor_pred_or_func(PredId, PredModule,
|
|
PredOrFunc, OrigArity).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- type record_resolved_item(T) ==
|
|
pred(module_qualifier, sym_name, arity, bool,
|
|
resolved_item_map(T), resolved_item_map(T),
|
|
recompilation_usage_info, recompilation_usage_info).
|
|
:- inst record_resolved_item ==
|
|
(pred(in, in, in, out, in, out, in, out) is det).
|
|
|
|
:- pred record_resolved_item(sym_name::in, arity::in,
|
|
record_resolved_item(T)::in(record_resolved_item),
|
|
resolved_item_set(T)::in, resolved_item_set(T)::out,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_resolved_item(SymName, Arity, RecordItem, !IdSet, !Info) :-
|
|
UnqualifiedName = unqualify_name(SymName),
|
|
ModuleQualifier = find_module_qualifier(SymName),
|
|
( if map.search(!.IdSet, UnqualifiedName, MatchingNames0) then
|
|
MatchingNames1 = MatchingNames0
|
|
else
|
|
MatchingNames1 = []
|
|
),
|
|
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, MatchingNames1, MatchingNames, !Info),
|
|
(
|
|
Recorded = yes,
|
|
map.set(UnqualifiedName, MatchingNames, !IdSet)
|
|
;
|
|
Recorded = no
|
|
).
|
|
|
|
:- pred record_resolved_item_2(module_qualifier::in, sym_name::in, arity::in,
|
|
record_resolved_item(T)::in(record_resolved_item), bool::out,
|
|
resolved_item_list(T)::in, resolved_item_list(T)::out,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem, Recorded,
|
|
!List, !Info) :-
|
|
!.List = [],
|
|
map.init(Map0),
|
|
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, Map0, Map, !Info),
|
|
(
|
|
Recorded = yes,
|
|
!:List = [Arity - Map]
|
|
;
|
|
Recorded = no
|
|
).
|
|
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem, Recorded,
|
|
!List, !Info) :-
|
|
!.List = [ThisArity - ArityMap0 | ListRest0],
|
|
( if Arity < ThisArity then
|
|
map.init(NewArityMap0),
|
|
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, NewArityMap0, NewArityMap, !Info),
|
|
(
|
|
Recorded = yes,
|
|
!:List = [Arity - NewArityMap | !.List]
|
|
;
|
|
Recorded = no
|
|
)
|
|
else if Arity = ThisArity then
|
|
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, ArityMap0, ArityMap, !Info),
|
|
(
|
|
Recorded = yes,
|
|
!:List = [Arity - ArityMap | ListRest0]
|
|
;
|
|
Recorded = no
|
|
)
|
|
else
|
|
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, ListRest0, ListRest, !Info),
|
|
(
|
|
Recorded = yes,
|
|
!:List = [ThisArity - ArityMap0 | ListRest]
|
|
;
|
|
Recorded = no
|
|
)
|
|
).
|
|
|
|
:- pred record_resolved_item_3(module_qualifier::in, sym_name::in, arity::in,
|
|
record_resolved_item(T)::in(record_resolved_item), bool::out,
|
|
resolved_item_map(T)::in, resolved_item_map(T)::out,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem, Recorded,
|
|
!ResolvedMap, !Info) :-
|
|
( if map.contains(!.ResolvedMap, ModuleQualifier) then
|
|
Recorded = no
|
|
else
|
|
RecordItem(ModuleQualifier, SymName, Arity, Recorded,
|
|
!ResolvedMap, !Info)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred find_items_used_by_item(item_type::in, item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_item(type_abstract_item, TypeCtorItem, !Info) :-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
TypeCtor = item_name_to_type_ctor(TypeCtorItem),
|
|
lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
( if TypeBody = hlds_eqv_type(Type) then
|
|
% If we use an equivalence type we also use the type
|
|
% it is equivalent to.
|
|
find_items_used_by_type(Type, !Info)
|
|
else
|
|
true
|
|
).
|
|
find_items_used_by_item(type_body_item, TypeCtorItem, !Info) :-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
TypeCtor = item_name_to_type_ctor(TypeCtorItem),
|
|
lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
find_items_used_by_type_body(TypeBody, !Info).
|
|
find_items_used_by_item(mode_item, ModeCtorItem, !Info):-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_mode_table(ModuleInfo, Modes),
|
|
mode_table_get_mode_defns(Modes, ModeDefns),
|
|
ModeCtor = item_name_to_mode_ctor(ModeCtorItem),
|
|
map.lookup(ModeDefns, ModeCtor, ModeDefn),
|
|
find_items_used_by_mode_defn(ModeDefn, !Info).
|
|
find_items_used_by_item(inst_item, InstCtorItem, !Info):-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_inst_table(ModuleInfo, Insts),
|
|
inst_table_get_user_insts(Insts, UserInstTable),
|
|
InstCtor = item_name_to_inst_ctor(InstCtorItem),
|
|
map.lookup(UserInstTable, InstCtor, InstDefn),
|
|
find_items_used_by_inst_defn(InstDefn, !Info).
|
|
find_items_used_by_item(typeclass_item, ClassItemId, !Info) :-
|
|
ClassItemId = item_name(ClassName, ClassArity),
|
|
ClassId = class_id(ClassName, ClassArity),
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_class_table(ModuleInfo, Classes),
|
|
map.lookup(Classes, ClassId, ClassDefn),
|
|
Constraints = ClassDefn ^ classdefn_supers,
|
|
ClassInterface = ClassDefn ^ classdefn_interface,
|
|
find_items_used_by_class_constraints(Constraints, !Info),
|
|
(
|
|
ClassInterface = class_interface_abstract
|
|
;
|
|
ClassInterface = class_interface_concrete(ClassDecls),
|
|
list.foldl(find_items_used_by_class_decl, ClassDecls, !Info)
|
|
),
|
|
module_info_get_instance_table(ModuleInfo, Instances),
|
|
( if map.search(Instances, ClassId, InstanceDefns) then
|
|
list.foldl(find_items_used_by_instance(ClassItemId), InstanceDefns,
|
|
!Info)
|
|
else
|
|
true
|
|
).
|
|
find_items_used_by_item(predicate_item, ItemId, !Info) :-
|
|
record_used_pred_or_func(pf_predicate, ItemId, !Info).
|
|
find_items_used_by_item(function_item, ItemId, !Info) :-
|
|
record_used_pred_or_func(pf_function, ItemId, !Info).
|
|
find_items_used_by_item(functor_item, _, !Info) :-
|
|
unexpected($pred, "functor").
|
|
find_items_used_by_item(mutable_item, _MutableItemId, !Info).
|
|
% XXX What should be done here???
|
|
find_items_used_by_item(foreign_proc_item, _, !Info).
|
|
%
|
|
% Mutables are expanded into other item types which track the
|
|
% types, insts, preds, and funcs used.
|
|
|
|
:- pred find_items_used_by_instances(class_id::in,
|
|
list(hlds_instance_defn)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_instances(ClassId, InstanceDefns, !Info) :-
|
|
ClassId = class_id(Name, Arity),
|
|
ClassIdItem = item_name(Name, Arity),
|
|
( if item_is_local(!.Info, ClassIdItem) then
|
|
record_expanded_items_used_by_item(typeclass_item, ClassIdItem, !Info),
|
|
list.foldl(find_items_used_by_instance(ClassIdItem), InstanceDefns,
|
|
!Info)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred find_items_used_by_instance(item_name::in, hlds_instance_defn::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_instance(ClassId, Defn, !Info) :-
|
|
% XXX Should we process OriginalArgTypes as we do ArgTypes?
|
|
Defn = hlds_instance_defn(InstanceModuleName, ArgTypes, _OriginalArgTypes,
|
|
_, _, Constraints, _, _, _, _),
|
|
% XXX Handle interface (currently not needed because the interfaces
|
|
% for imported instances are only needed with --intermodule-optimization,
|
|
% which isn't handled here yet).
|
|
ModuleInfo = !.Info ^ module_info,
|
|
( if module_info_get_name(ModuleInfo, InstanceModuleName) then
|
|
true
|
|
else
|
|
find_items_used_by_class_constraints(Constraints, !Info),
|
|
find_items_used_by_types(ArgTypes, !Info),
|
|
ModuleInstances0 = !.Info ^ module_instances,
|
|
( if
|
|
map.search(ModuleInstances0, InstanceModuleName, ClassIdsPrime)
|
|
then
|
|
ClassIds1 = ClassIdsPrime
|
|
else
|
|
set.init(ClassIds1)
|
|
),
|
|
set.insert(ClassId, ClassIds1, ClassIds),
|
|
map.set(InstanceModuleName, ClassIds,
|
|
ModuleInstances0, ModuleInstances),
|
|
!Info ^ module_instances := ModuleInstances
|
|
).
|
|
|
|
:- pred find_items_used_by_class_decl(class_decl::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_decl(Decl, !Info) :-
|
|
(
|
|
Decl = class_decl_pred_or_func(PredOrFuncInfo),
|
|
PredOrFuncInfo = class_pred_or_func_info(_, _, ArgTypesAndModes,
|
|
_, _, _, _, _, _, _, Constraints, _),
|
|
find_items_used_by_class_context(Constraints, !Info),
|
|
list.foldl(find_items_used_by_type_and_mode, ArgTypesAndModes, !Info)
|
|
;
|
|
Decl = class_decl_mode(ModeInfo),
|
|
ModeInfo = class_mode_info(_, _, Modes, _, _, _, _),
|
|
find_items_used_by_modes(Modes, !Info)
|
|
).
|
|
|
|
:- pred find_items_used_by_type_and_mode(type_and_mode::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_and_mode(TypeAndMode, !Info) :-
|
|
(
|
|
TypeAndMode = type_only(Type)
|
|
;
|
|
TypeAndMode = type_and_mode(Type, Mode),
|
|
find_items_used_by_mode(Mode, !Info)
|
|
),
|
|
find_items_used_by_type(Type, !Info).
|
|
|
|
:- pred find_items_used_by_type_body(hlds_type_body::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_body(TypeBody, !Info) :-
|
|
(
|
|
TypeBody = hlds_du_type(Ctors, _, _, _),
|
|
list.foldl(find_items_used_by_ctor, one_or_more_to_list(Ctors), !Info)
|
|
;
|
|
TypeBody = hlds_eqv_type(EqvType),
|
|
find_items_used_by_type(EqvType, !Info)
|
|
;
|
|
( TypeBody = hlds_abstract_type(_)
|
|
; TypeBody = hlds_foreign_type(_)
|
|
)
|
|
;
|
|
TypeBody = hlds_solver_type(_)
|
|
% rafe: XXX Should we trace the representation type?
|
|
).
|
|
|
|
:- pred find_items_used_by_ctor(constructor::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_ctor(Ctor, !Info) :-
|
|
Ctor = ctor(_, MaybeExistConstraints, _, CtorArgs, _, _),
|
|
(
|
|
MaybeExistConstraints = no_exist_constraints
|
|
;
|
|
MaybeExistConstraints = exist_constraints(ExistConstraints),
|
|
ExistConstraints = cons_exist_constraints(_, Constraints, _, _),
|
|
find_items_used_by_class_constraints(Constraints, !Info)
|
|
),
|
|
list.foldl(find_items_used_by_ctor_arg, CtorArgs, !Info).
|
|
|
|
:- pred find_items_used_by_ctor_arg(constructor_arg::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_ctor_arg(CtorArg, !Info) :-
|
|
ArgType = CtorArg ^ arg_type,
|
|
find_items_used_by_type(ArgType, !Info).
|
|
|
|
:- pred find_items_used_by_mode_defn(hlds_mode_defn::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_mode_defn(Defn, !Info) :-
|
|
Defn = hlds_mode_defn(_, _, hlds_mode_body(Mode), _, _),
|
|
find_items_used_by_mode(Mode, !Info).
|
|
|
|
:- pred find_items_used_by_inst_defn(hlds_inst_defn::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_inst_defn(Defn, !Info) :-
|
|
Defn = hlds_inst_defn(_, _, InstBody, IFTC, _, _),
|
|
InstBody = eqv_inst(Inst),
|
|
find_items_used_by_inst(Inst, !Info),
|
|
(
|
|
IFTC = iftc_applicable_declared(ForTypeCtor),
|
|
find_items_used_by_type_ctor(ForTypeCtor, !Info)
|
|
;
|
|
IFTC = iftc_applicable_known(MatchingTypeCtors),
|
|
list.foldl(find_items_used_by_type_ctor, MatchingTypeCtors, !Info)
|
|
;
|
|
( IFTC = iftc_applicable_not_known
|
|
; IFTC = iftc_applicable_error
|
|
; IFTC = iftc_not_applicable
|
|
)
|
|
).
|
|
|
|
:- pred find_items_used_by_preds(pred_or_func::in, pred_or_func_set::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_preds(PredOrFunc, Set, !Info) :-
|
|
map.foldl(find_items_used_by_preds_2(PredOrFunc), Set, !Info).
|
|
|
|
:- pred find_items_used_by_preds_2(pred_or_func::in,
|
|
pair(string, arity)::in, map(module_qualifier, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_preds_2(PredOrFunc, Name - Arity, MatchingPredMap, !Info) :-
|
|
map.foldl(find_items_used_by_preds_3(
|
|
PredOrFunc, Name, Arity), MatchingPredMap, !Info).
|
|
|
|
:- pred find_items_used_by_preds_3(pred_or_func::in,
|
|
string::in, arity::in, module_qualifier::in, module_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_preds_3(PredOrFunc, Name, Arity, ModuleQualifier, _,
|
|
!Info) :-
|
|
SymName = module_qualify_name(ModuleQualifier, Name),
|
|
record_used_pred_or_func(PredOrFunc, item_name(SymName, Arity), !Info).
|
|
|
|
:- pred find_items_used_by_pred(pred_or_func::in,
|
|
pair(string, arity)::in, pair(pred_id, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_pred(PredOrFunc, Name - Arity, PredId - PredModule,
|
|
!Info) :-
|
|
ItemType = pred_or_func_to_item_type(PredOrFunc),
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
( if
|
|
ItemName = item_name(qualified(PredModule, Name), Arity),
|
|
(
|
|
item_is_recorded_used(!.Info, ItemType, ItemName)
|
|
;
|
|
item_is_local(!.Info, ItemName)
|
|
)
|
|
then
|
|
% We have already recorded the items used by this predicate.
|
|
true
|
|
else if
|
|
% Items used by class methods are recorded when processing
|
|
% the typeclass declaration. Make sure that is done.
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
check_marker(Markers, marker_class_method)
|
|
then
|
|
% The typeclass for which the predicate is a method is the first
|
|
% of the universal class constraints in the pred_info.
|
|
pred_info_get_class_context(PredInfo, MethodClassContext),
|
|
MethodClassContext = constraints(MethodUnivConstraints, _),
|
|
(
|
|
MethodUnivConstraints = [MethodUnivConstraint | _],
|
|
MethodUnivConstraint = constraint(ClassName, ClassArgTypes),
|
|
ClassArity = list.length(ClassArgTypes)
|
|
;
|
|
MethodUnivConstraints = [],
|
|
unexpected($pred, "class method with no class constraints")
|
|
),
|
|
maybe_record_item_to_process(typeclass_item,
|
|
item_name(ClassName, ClassArity), !Info)
|
|
else
|
|
ItemName = item_name(qualified(PredModule, Name), Arity),
|
|
record_expanded_items_used_by_item(ItemType, ItemName, !Info),
|
|
record_imported_item(ItemType, ItemName, !Info),
|
|
pred_info_get_arg_types(PredInfo, ArgTypes),
|
|
find_items_used_by_types(ArgTypes, !Info),
|
|
pred_info_get_proc_table(PredInfo, Procs),
|
|
map.foldl(find_items_used_by_proc_arg_modes, Procs, !Info),
|
|
pred_info_get_class_context(PredInfo, ClassContext),
|
|
find_items_used_by_class_context(ClassContext, !Info),
|
|
|
|
% Record items used by `:- pragma type_spec' declarations.
|
|
module_info_get_type_spec_info(ModuleInfo, TypeSpecInfo),
|
|
TypeSpecInfo = type_spec_info(_, _, _, PragmaMap),
|
|
( if map.search(PragmaMap, PredId, TypeSpecPragmas) then
|
|
list.foldl(find_items_used_by_type_spec, TypeSpecPragmas, !Info)
|
|
else
|
|
true
|
|
)
|
|
).
|
|
|
|
:- pred find_items_used_by_proc_arg_modes(proc_id::in, proc_info::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_proc_arg_modes(_ProcId, ProcInfo, !Info) :-
|
|
proc_info_get_argmodes(ProcInfo, ArgModes),
|
|
find_items_used_by_modes(ArgModes, !Info).
|
|
|
|
:- pred find_items_used_by_type_spec(pragma_info_type_spec::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_spec(TypeSpecInfo, !Info) :-
|
|
TypeSpecInfo = pragma_info_type_spec(_, _, _, _, MaybeModes, Subst, _, _),
|
|
(
|
|
MaybeModes = yes(Modes),
|
|
find_items_used_by_modes(Modes, !Info)
|
|
;
|
|
MaybeModes = no
|
|
),
|
|
assoc_list.values(Subst, SubstTypes),
|
|
find_items_used_by_types(SubstTypes, !Info).
|
|
|
|
:- pred find_items_used_by_functors(functor_set::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_functors(Set, !Info) :-
|
|
map.foldl(find_items_used_by_functors_2, Set, !Info).
|
|
|
|
:- pred find_items_used_by_functors_2(pair(string, arity)::in,
|
|
map(module_qualifier, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_functors_2(Name - Arity, MatchingCtorMap, !Info) :-
|
|
map.foldl(find_items_used_by_functors_3(Name, Arity), MatchingCtorMap,
|
|
!Info).
|
|
|
|
:- pred find_items_used_by_functors_3(string::in, arity::in,
|
|
module_qualifier::in, module_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_functors_3(Name, Arity, Qualifier, _, !Info) :-
|
|
SymName = module_qualify_name(Qualifier, Name),
|
|
record_used_functor(SymName - Arity, !Info).
|
|
|
|
:- pred find_items_used_by_functor(string::in, arity::in, resolved_functor::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_functor(Name, _Arity, ResolverFunctor, !Info) :-
|
|
ResolverFunctor = resolved_functor_pred_or_func(PredId, PredModule,
|
|
PredOrFunc, PredArity),
|
|
find_items_used_by_pred(PredOrFunc, Name - PredArity, PredId - PredModule,
|
|
!Info).
|
|
find_items_used_by_functor(_, _, ResolverFunctor, !Info) :-
|
|
ResolverFunctor = resolved_functor_constructor(TypeCtor),
|
|
maybe_record_item_to_process(type_body_item, TypeCtor, !Info).
|
|
find_items_used_by_functor(_, _, ResolverFunctor, !Info) :-
|
|
ResolverFunctor = resolved_functor_field(TypeCtor, _),
|
|
maybe_record_item_to_process(type_body_item, TypeCtor, !Info).
|
|
|
|
:- pred find_items_used_by_simple_item_set(item_type::in, simple_item_set::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_simple_item_set(ItemType, Set, !Info) :-
|
|
map.foldl(find_items_used_by_simple_item_set_2(ItemType), Set, !Info).
|
|
|
|
:- pred find_items_used_by_simple_item_set_2(item_type::in,
|
|
pair(string, arity)::in, map(module_qualifier, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_simple_item_set_2(ItemType, Name - Arity, MatchingIdMap,
|
|
!Info) :-
|
|
map.foldl(find_items_used_by_simple_item_set_3(ItemType, Name, Arity),
|
|
MatchingIdMap, !Info).
|
|
|
|
:- pred find_items_used_by_simple_item_set_3(item_type::in,
|
|
string::in, arity::in, module_qualifier::in, module_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_simple_item_set_3(ItemType, Name, Arity, _, Module,
|
|
!Info) :-
|
|
maybe_record_item_to_process(ItemType,
|
|
item_name(qualified(Module, Name), Arity), !Info).
|
|
|
|
:- pred find_items_used_by_types(list(mer_type)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_types(Types, !Info) :-
|
|
list.foldl(find_items_used_by_type, Types, !Info).
|
|
|
|
:- pred find_items_used_by_type(mer_type::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type(Type, !Info) :-
|
|
( if type_to_ctor_and_args(Type, TypeCtor, TypeArgs) then
|
|
find_items_used_by_type_ctor(TypeCtor, !Info),
|
|
find_items_used_by_types(TypeArgs, !Info)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred find_items_used_by_type_ctor(type_ctor::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_ctor(TypeCtor, !Info) :-
|
|
( if
|
|
% Unqualified type constructor names are builtins.
|
|
TypeCtor = type_ctor(qualified(_, _), _),
|
|
not type_ctor_is_higher_order(TypeCtor, _, _, _)
|
|
then
|
|
TypeCtorItem = type_ctor_to_item_name(TypeCtor),
|
|
maybe_record_item_to_process(type_abstract_item, TypeCtorItem, !Info)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred find_items_used_by_modes(list(mer_mode)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_modes(Modes, !Info) :-
|
|
list.foldl(find_items_used_by_mode, Modes, !Info).
|
|
|
|
:- pred find_items_used_by_mode(mer_mode::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_mode(from_to_mode(Inst1, Inst2), !Info) :-
|
|
find_items_used_by_inst(Inst1, !Info),
|
|
find_items_used_by_inst(Inst2, !Info).
|
|
find_items_used_by_mode(user_defined_mode(ModeName, ArgInsts), !Info) :-
|
|
list.length(ArgInsts, ModeArity),
|
|
maybe_record_item_to_process(mode_item, item_name(ModeName, ModeArity),
|
|
!Info),
|
|
find_items_used_by_insts(ArgInsts, !Info).
|
|
|
|
:- pred find_items_used_by_insts(list(mer_inst)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_insts(Modes, !Info) :-
|
|
list.foldl(find_items_used_by_inst, Modes, !Info).
|
|
|
|
:- pred find_items_used_by_inst(mer_inst::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_inst(Inst, !Info) :-
|
|
(
|
|
( Inst = not_reached
|
|
; Inst = free
|
|
; Inst = free(_)
|
|
; Inst = inst_var(_)
|
|
)
|
|
;
|
|
( Inst = any(_, HOInstInfo)
|
|
; Inst = ground(_, HOInstInfo)
|
|
),
|
|
(
|
|
HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
|
|
find_items_used_by_modes(Modes, !Info)
|
|
;
|
|
HOInstInfo = none_or_default_func
|
|
)
|
|
;
|
|
Inst = bound(_, _, BoundInsts),
|
|
list.foldl(find_items_used_by_bound_inst, BoundInsts, !Info)
|
|
;
|
|
Inst = constrained_inst_vars(_, SubInst),
|
|
find_items_used_by_inst(SubInst, !Info)
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
find_items_used_by_inst_name(InstName, !Info)
|
|
;
|
|
Inst = abstract_inst(Name, ArgInsts),
|
|
list.length(ArgInsts, Arity),
|
|
maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
|
|
find_items_used_by_insts(ArgInsts, !Info)
|
|
).
|
|
|
|
:- pred find_items_used_by_bound_inst(bound_inst::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_bound_inst(BoundInst, !Info) :-
|
|
BoundInst = bound_functor(ConsId, ArgInsts),
|
|
( if ConsId = cons(Name, Arity, _) then
|
|
record_used_functor(Name - Arity, !Info)
|
|
else
|
|
true
|
|
),
|
|
find_items_used_by_insts(ArgInsts, !Info).
|
|
|
|
:- pred find_items_used_by_inst_name(inst_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_inst_name(InstName, !Info) :-
|
|
(
|
|
InstName = user_inst(Name, ArgInsts),
|
|
list.length(ArgInsts, Arity),
|
|
maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
|
|
find_items_used_by_insts(ArgInsts, !Info)
|
|
;
|
|
( InstName = merge_inst(InstA, InstB)
|
|
; InstName = unify_inst(_, _, InstA, InstB)
|
|
),
|
|
find_items_used_by_inst(InstA, !Info),
|
|
find_items_used_by_inst(InstB, !Info)
|
|
;
|
|
( InstName = ground_inst(SubInstName, _, _, _)
|
|
; InstName = any_inst(SubInstName, _, _, _)
|
|
; InstName = shared_inst(SubInstName)
|
|
; InstName = mostly_uniq_inst(SubInstName)
|
|
),
|
|
find_items_used_by_inst_name(SubInstName, !Info)
|
|
;
|
|
InstName = typed_ground(_, Type),
|
|
find_items_used_by_type(Type, !Info)
|
|
;
|
|
InstName = typed_inst(Type, SubInstName),
|
|
find_items_used_by_type(Type, !Info),
|
|
find_items_used_by_inst_name(SubInstName, !Info)
|
|
).
|
|
|
|
:- pred find_items_used_by_class_context(prog_constraints::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_context(constraints(Constraints1, Constraints2),
|
|
!Info) :-
|
|
find_items_used_by_class_constraints(Constraints1, !Info),
|
|
find_items_used_by_class_constraints(Constraints2, !Info).
|
|
|
|
:- pred find_items_used_by_class_constraints(list(prog_constraint)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_constraints(Constraints, !Info) :-
|
|
list.foldl(find_items_used_by_class_constraint, Constraints, !Info).
|
|
|
|
:- pred find_items_used_by_class_constraint(prog_constraint::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_constraint(Constraint, !Info) :-
|
|
Constraint = constraint(ClassName, ArgTypes),
|
|
ClassArity = list.length(ArgTypes),
|
|
maybe_record_item_to_process(typeclass_item,
|
|
item_name(ClassName, ClassArity), !Info),
|
|
find_items_used_by_types(ArgTypes, !Info).
|
|
|
|
:- pred maybe_record_item_to_process(item_type::in, item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
maybe_record_item_to_process(ItemType, ItemName, !Info) :-
|
|
( if ItemType = typeclass_item then
|
|
Classes0 = !.Info ^ used_typeclasses,
|
|
set.insert(ItemName, Classes0, Classes),
|
|
!Info ^ used_typeclasses := Classes
|
|
else
|
|
true
|
|
),
|
|
|
|
( if item_is_recorded_used(!.Info, ItemType, ItemName) then
|
|
% This item has already been recorded.
|
|
true
|
|
else if item_is_local(!.Info, ItemName) then
|
|
% Ignore local items. The items used by them have already been recorded
|
|
% by module_qual.m.
|
|
true
|
|
else
|
|
Queue0 = !.Info ^ item_queue,
|
|
queue.put(item_id(ItemType, ItemName), Queue0, Queue),
|
|
!Info ^ item_queue := Queue,
|
|
|
|
record_imported_item(ItemType, ItemName, !Info),
|
|
record_expanded_items_used_by_item(ItemType, ItemName, !Info)
|
|
).
|
|
|
|
:- pred item_is_recorded_used(recompilation_usage_info::in,
|
|
item_type::in, item_name::in) is semidet.
|
|
|
|
item_is_recorded_used(Info, ItemType, ItemName) :-
|
|
ImportedItems = Info ^ imported_items,
|
|
ItemName = item_name(qualified(ModuleName, Name), Arity),
|
|
map.search(ImportedItems, ModuleName, ModuleIdSet),
|
|
ModuleItemIdSet = extract_ids(ModuleIdSet, ItemType),
|
|
set.member(Name - Arity, ModuleItemIdSet).
|
|
|
|
:- pred item_is_local(recompilation_usage_info::in, item_name::in) is semidet.
|
|
|
|
item_is_local(Info, ItemName) :-
|
|
ItemName = item_name(qualified(ModuleName, _), _),
|
|
module_info_get_name(Info ^ module_info, ModuleName).
|
|
|
|
:- pred record_imported_item(item_type::in, item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_imported_item(ItemType, ItemName, !Info) :-
|
|
ItemName = item_name(SymName, Arity),
|
|
(
|
|
SymName = qualified(Module0, Name0),
|
|
Module = Module0,
|
|
Name = Name0
|
|
;
|
|
SymName = unqualified(_),
|
|
unexpected($pred, "unqualified item")
|
|
),
|
|
|
|
ImportedItems0 = !.Info ^ imported_items,
|
|
( if map.search(ImportedItems0, Module, ModuleItems0) then
|
|
ModuleItems1 = ModuleItems0
|
|
else
|
|
ModuleItems1 = init_item_id_set(set.init)
|
|
),
|
|
ModuleItemIds0 = extract_ids(ModuleItems1, ItemType),
|
|
set.insert(Name - Arity, ModuleItemIds0, ModuleItemIds),
|
|
update_ids(ItemType, ModuleItemIds, ModuleItems1, ModuleItems),
|
|
map.set(Module, ModuleItems, ImportedItems0, ImportedItems),
|
|
!Info ^ imported_items := ImportedItems.
|
|
|
|
% Uses of equivalence types have been expanded away by equiv_type.m.
|
|
% equiv_type.m records which equivalence types were used by each
|
|
% imported item.
|
|
%
|
|
:- pred record_expanded_items_used_by_item(item_type::in, item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_expanded_items_used_by_item(ItemType, NameArity, !Info) :-
|
|
Dependencies = !.Info ^ dependencies,
|
|
( if
|
|
map.search(Dependencies, item_id(ItemType, NameArity), EquivTypes)
|
|
then
|
|
list.foldl(record_expanded_items_used_by_item_2,
|
|
set.to_sorted_list(EquivTypes), !Info)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred record_expanded_items_used_by_item_2(item_id::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_expanded_items_used_by_item_2(Item, !Info) :-
|
|
Item = item_id(DepItemType, DepItemId),
|
|
maybe_record_item_to_process(DepItemType, DepItemId, !Info).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module recompilation.usage.
|
|
%-----------------------------------------------------------------------------%
|