mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-19 15:54:18 +00:00
2ac8465659
The motivation for this diff was that I wanted the compiler to generate
a warning if a module declared the same type twice. (During the cleanup
of unify_proc.m I did recently, I found and fixed such a duplicate
declaration.)
compiler/add_type.m:
The old code of module_add_type_defn was not just long (210+ lines),
it is also very complex.
Part of this complexity was sort-of justified. It dealt with adding
three separate kinds of item_type_defns: abstract type "definitions",
which are actually declarations; the definitions of Mercury types,
and the definitions of foreign types. A single type could have more than
one of these (e.g. declaration and a definition, or a Mercury definition
and a foreign definition), and it had to be prepared to process these
in any order.
Part of this complexity was self-inflicted. The parts of the predicate
that dealt with the same kind of definition were not always next to each
other, and for some parts, it wasn't even clear *what* kind of definition
it was dealing with. It did the same tests on both the old and updated
versions of definitions, when those definitions were guaranteed to be
identical; the "updating" predicate was a no-op. And it used completely
different code for detecting and handling related errors.
This diff fixes the above problems. It separates the task of adding
an item_type_defn to the HLDS into three subtasks, done in three separate
predicates: adding type declarations, adding Mercury definitions, and
adding foreign definitions. It specializes each predicate to its task,
and simplifies its decision flow. It also delegates the creation of
(most) error messages to separate predicates. Together, these changes
make each of module_add_type_defn_{abstract,mercury,foreign} easily
understandable.
Generate a warning if a type is declared twice, i.e. if e.g.
":- type x." is followed by another ":- type x.".
Call module_info_incr_errors to register the presence of errors in just
one central place. (Before, some of the places that generated error
messages incremented the error count, and some places didn't.)
Improve the wording of some error messages.
Refer to type names in error messages by unqualified sym_names
in cases where the module qualifier being elided is obvious from
the name of the module being compiled.
Add documentation.
Add descriptions of potential future improvements.
Add some XXXs at places that I think deserve them.
Give some predicates and variables better names.
compiler/prog_data.m:
Change the parse tree representation of type definitions by
explicitly specifying a type for storing the contents of each kind
of type definition.
compiler/hlds_data.m:
Give a predicate a better name.
Use one of the new types in prog_data.m in the HLDS version of type
definitions, to minimize differences between the parse tree and HLDS
versions.
compiler/add_foreign_enum.m:
compiler/add_pragma.m:
compiler/add_special_pred.m:
compiler/check_typeclass.m:
compiler/du_type_layout.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/foreign.m:
compiler/get_dependencies.m:
compiler/hlds_code_util.m:
compiler/hlds_out_module.m:
compiler/inst_check.m:
compiler/intermod.m:
compiler/item_util.m:
compiler/make_hlds_passes.m:
compiler/make_hlds_separate_items.m:
compiler/make_tags.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/module_qual.qualify_items.m:
compiler/parse_pragma.m:
compiler/parse_tree_out.m:
compiler/parse_type_defn.m:
compiler/post_term_analysis.m:
compiler/recompilation.check.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/resolve_unify_functor.m:
compiler/simplify_goal_ite.m:
compiler/special_pred.m:
compiler/switch_util.m:
compiler/term_norm.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/write_module_interface_files.m:
compiler/xml_documentation.m:
Conform to the changes in prog_data.m.
library/io.m:
library/store.m:
Delete duplicate type declarations that add_type.m now complains about.
tests/invalid/bad_foreign_type.{m,err_exp}:
Extend this test to test the new warning.
Expect the updated versions of some error messages.
tests/invalid/extra_info_prompt.err_exp:
tests/invalid/foreign_type_visibility.err_exp:
tests/invalid/user_eq_dummy.err_exp:
Expect the updated versions of some error messages.
1542 lines
58 KiB
Mathematica
1542 lines
58 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.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- 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_data.
|
|
:- import_module hlds.pred_table.
|
|
:- 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_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 queue.
|
|
:- import_module require.
|
|
|
|
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, do_create_dirs, ".used",
|
|
ModuleName, FileName, !IO),
|
|
io.open_output(FileName, FileResult, !IO),
|
|
(
|
|
FileResult = ok(Stream0),
|
|
io.set_output_stream(Stream0, OldStream, !IO),
|
|
write_usage_file_2(ModuleInfo,
|
|
set.to_sorted_list(NestedSubModules), RecompInfo, TimestampMap,
|
|
!IO),
|
|
io.set_output_stream(OldStream, Stream, !IO),
|
|
io.close_output(Stream, !IO)
|
|
;
|
|
FileResult = error(IOError),
|
|
io.error_message(IOError, IOErrorMessage),
|
|
io.write_string("\nError opening `", !IO),
|
|
io.write_string(FileName, !IO),
|
|
io.write_string("'for output: ", !IO),
|
|
io.write_string(IOErrorMessage, !IO),
|
|
io.write_string(".\n", !IO),
|
|
io.set_exit_status(1, !IO)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred write_usage_file_2(module_info::in,
|
|
list(module_name)::in, recompilation_info::in,
|
|
module_timestamp_map::in, io::di, io::uo) is det.
|
|
|
|
write_usage_file_2(ModuleInfo, NestedSubModules, RecompInfo, TimestampMap,
|
|
!IO) :-
|
|
io.write_int(usage_file_version_number, !IO),
|
|
io.write_string(",", !IO),
|
|
io.write_int(version_numbers_version_number, !IO),
|
|
io.write_string(".\n\n", !IO),
|
|
|
|
module_info_get_name(ModuleInfo, ThisModuleName),
|
|
map.lookup(TimestampMap, ThisModuleName,
|
|
module_timestamp(_, ThisModuleTimestamp, _)),
|
|
io.write_string("(", !IO),
|
|
mercury_output_bracketed_sym_name(ThisModuleName, !IO),
|
|
io.write_string(", "".m"", ", !IO),
|
|
write_version_number(ThisModuleTimestamp, !IO),
|
|
io.write_string(").\n\n", !IO),
|
|
|
|
(
|
|
NestedSubModules = [],
|
|
io.write_string("sub_modules.\n\n", !IO)
|
|
;
|
|
NestedSubModules = [_ | _],
|
|
io.write_string("sub_modules(", !IO),
|
|
io.write_list(NestedSubModules, ", ",
|
|
mercury_output_bracketed_sym_name, !IO),
|
|
io.write_string(").\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("used_items.\n", !IO)
|
|
else
|
|
io.write_string("used_items(\n\t", !IO),
|
|
some [!WriteComma] (
|
|
!:WriteComma = no,
|
|
write_simple_item_matches(type_abstract_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_simple_item_matches(type_body_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_simple_item_matches(mode_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_simple_item_matches(inst_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_simple_item_matches(typeclass_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_pred_or_func_matches(predicate_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_pred_or_func_matches(function_item, ResolvedUsedItems,
|
|
!WriteComma, !IO),
|
|
write_functor_matches(ResolvedUsedItems ^ functors,
|
|
!WriteComma, !IO),
|
|
_ = !.WriteComma
|
|
),
|
|
io.write_string("\n).\n\n", !IO)
|
|
),
|
|
|
|
( if set.is_empty(UsedClasses) then
|
|
io.write_string("used_classes.\n", !IO)
|
|
else
|
|
io.write_string("used_classes(", !IO),
|
|
io.write_list(set.to_sorted_list(UsedClasses), ", ",
|
|
write_classname_and_arity, !IO),
|
|
io.write_string(").\n", !IO)
|
|
),
|
|
|
|
map.foldl(
|
|
write_module_name_and_used_items(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(!IO),
|
|
io.write_string("done.\n", !IO).
|
|
|
|
:- pred write_module_name_and_used_items(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(RecompInfo, TimestampMap, ModuleInstances,
|
|
ModuleName, ModuleUsedItems, !IO) :-
|
|
io.nl(!IO),
|
|
io.write_string("(", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, !IO),
|
|
io.write_string(", """, !IO),
|
|
map.lookup(TimestampMap, ModuleName,
|
|
module_timestamp(FileKind, ModuleTimestamp, NeedQualifier)),
|
|
io.write_string(file_kind_to_extension(FileKind), !IO),
|
|
io.write_string(""", ", !IO),
|
|
write_version_number(ModuleTimestamp, !IO),
|
|
(
|
|
NeedQualifier = must_be_qualified,
|
|
io.write_string(", used)", !IO)
|
|
;
|
|
NeedQualifier = may_be_unqualified,
|
|
io.write_string(")", !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(" => ", !IO),
|
|
ModuleUsedVersionNumbers =
|
|
version_numbers(ModuleUsedItemVersions,
|
|
ModuleUsedInstanceVersions),
|
|
write_version_numbers(ModuleUsedVersionNumbers, !IO),
|
|
io.write_string(".\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(".\n", !IO)
|
|
).
|
|
|
|
:- pred write_classname_and_arity(item_name::in, io::di, io::uo) is det.
|
|
|
|
write_classname_and_arity(item_name(ClassName, ClassArity), !IO) :-
|
|
mercury_output_bracketed_sym_name(ClassName, !IO),
|
|
io.write_string("/", !IO),
|
|
io.write_int(ClassArity, !IO).
|
|
|
|
:- pred write_comma_if_needed(bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_comma_if_needed(!WriteComma, !IO) :-
|
|
(
|
|
!.WriteComma = yes,
|
|
io.write_string(",\n\t", !IO)
|
|
;
|
|
!.WriteComma = no
|
|
),
|
|
!:WriteComma = yes.
|
|
|
|
:- pred write_simple_item_matches(item_type::in(simple_item),
|
|
resolved_used_items::in, bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches(ItemType, UsedItems, !WriteComma, !IO) :-
|
|
Ids = extract_simple_item_set(UsedItems, ItemType),
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(!WriteComma, !IO),
|
|
write_simple_item_matches_2(ItemType, Ids, !IO)
|
|
).
|
|
|
|
:- pred write_simple_item_matches_2(item_type::in, simple_item_set::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_2(ItemType, ItemSet, !IO) :-
|
|
string_to_item_type(ItemTypeStr, ItemType),
|
|
io.write_string(ItemTypeStr, !IO),
|
|
io.write_string("(\n\t\t", !IO),
|
|
map.to_assoc_list(ItemSet, ItemList),
|
|
io.write_list(ItemList, ",\n\t\t", write_simple_item_matches_3, !IO),
|
|
io.write_string("\n\t)", !IO).
|
|
|
|
:- pred write_simple_item_matches_3(
|
|
pair(pair(string, arity), map(module_qualifier, module_name))::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_3((Name - Arity) - Matches, !IO) :-
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
unqualified(Name), !IO),
|
|
io.write_string("/", !IO),
|
|
io.write_int(Arity, !IO),
|
|
io.write_string(" - (", !IO),
|
|
map.to_assoc_list(Matches, MatchList),
|
|
io.write_list(MatchList, ", ", write_simple_item_matches_4, !IO),
|
|
io.write_string(")", !IO).
|
|
|
|
:- pred write_simple_item_matches_4(pair(module_qualifier, module_name)::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_simple_item_matches_4(Qualifier - ModuleName, !IO) :-
|
|
mercury_output_bracketed_sym_name(Qualifier, !IO),
|
|
( if Qualifier = ModuleName then
|
|
true
|
|
else
|
|
io.write_string(" => ", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, !IO)
|
|
).
|
|
|
|
:- pred write_pred_or_func_matches(item_type::in(pred_or_func),
|
|
resolved_used_items::in, bool::in, bool::out,
|
|
io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches(ItemType, UsedItems, !WriteComma, !IO) :-
|
|
Ids = extract_pred_or_func_set(UsedItems, ItemType),
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(!WriteComma, !IO),
|
|
write_pred_or_func_matches_2(ItemType, Ids, !IO)
|
|
).
|
|
|
|
:- pred write_pred_or_func_matches_2(item_type::in(pred_or_func),
|
|
resolved_pred_or_func_set::in, io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches_2(ItemType, ItemSet, !IO) :-
|
|
write_resolved_item_set(ItemType, ItemSet,
|
|
write_pred_or_func_matches_3, !IO).
|
|
|
|
:- pred write_pred_or_func_matches_3(
|
|
pair(sym_name, set(pair(pred_id, sym_name)))::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_pred_or_func_matches_3(Qualifier - PredIdModuleNames, !IO) :-
|
|
ModuleNames = assoc_list.values(set.to_sorted_list(PredIdModuleNames)),
|
|
mercury_output_bracketed_sym_name(Qualifier, !IO),
|
|
( if ModuleNames = [Qualifier] then
|
|
true
|
|
else
|
|
io.write_string(" => (", !IO),
|
|
io.write_list(ModuleNames, ", ", mercury_output_bracketed_sym_name,
|
|
!IO),
|
|
io.write_string(")", !IO)
|
|
).
|
|
|
|
:- pred write_functor_matches(resolved_functor_set::in,
|
|
bool::in, bool::out, io::di, io::uo) is det.
|
|
|
|
write_functor_matches(Ids, !WriteComma, !IO) :-
|
|
( if map.is_empty(Ids) then
|
|
true
|
|
else
|
|
write_comma_if_needed(!WriteComma, !IO),
|
|
write_resolved_item_set(functor_item, Ids, write_functor_matches_2,
|
|
!IO)
|
|
).
|
|
|
|
:- pred write_functor_matches_2(pair(sym_name, set(resolved_functor))::in,
|
|
io::di, io::uo) is det.
|
|
|
|
write_functor_matches_2(Qualifier - MatchingCtors, !IO) :-
|
|
mercury_output_bracketed_sym_name(Qualifier, !IO),
|
|
io.write_string(" => (", !IO),
|
|
io.write_list(set.to_sorted_list(MatchingCtors), ", ",
|
|
write_resolved_functor, !IO),
|
|
io.write_string(")", !IO).
|
|
|
|
:- type write_resolved_item(T) == pred(pair(module_qualifier, T), io, io).
|
|
:- inst write_resolved_item == (pred(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::di, io::uo) is det.
|
|
|
|
write_resolved_item_set(ItemType, ItemSet, WriteMatches, !IO) :-
|
|
string_to_item_type(ItemTypeStr, ItemType),
|
|
io.write_string(ItemTypeStr, !IO),
|
|
io.write_string("(\n\t\t", !IO),
|
|
map.to_assoc_list(ItemSet, ItemList),
|
|
io.write_list(ItemList, ",\n\t\t",
|
|
write_resolved_item_set_2(WriteMatches), !IO),
|
|
io.write_string("\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::di, io::uo) is det.
|
|
|
|
write_resolved_item_set_2(WriteMatches, Name - MatchesAL, !IO) :-
|
|
mercury_output_bracketed_sym_name(unqualified(Name), !IO),
|
|
io.write_string(" - (", !IO),
|
|
io.write_list(MatchesAL, ",\n\t\t\t",
|
|
write_resolved_item_set_3(WriteMatches), !IO),
|
|
io.write_string(")", !IO).
|
|
|
|
:- pred write_resolved_item_set_3(
|
|
write_resolved_item(T)::in(write_resolved_item),
|
|
pair(int, map(sym_name, T))::in, io::di, io::uo) is det.
|
|
|
|
write_resolved_item_set_3(WriteMatches, Arity - Matches, !IO) :-
|
|
io.write_int(Arity, !IO),
|
|
io.write_string(" - (", !IO),
|
|
map.to_assoc_list(Matches, MatchList),
|
|
io.write_list(MatchList, ",\n\t\t\t\t", WriteMatches, !IO),
|
|
io.write_string(")", !IO).
|
|
|
|
:- pred write_resolved_functor(resolved_functor::in, io::di, io::uo) is det.
|
|
|
|
write_resolved_functor(ResolvedFunctor, !IO) :-
|
|
(
|
|
ResolvedFunctor = resolved_functor_pred_or_func(_, ModuleName,
|
|
PredOrFunc, Arity),
|
|
write_pred_or_func(PredOrFunc, !IO),
|
|
io.write_string("(", !IO),
|
|
mercury_output_bracketed_sym_name(ModuleName, !IO),
|
|
io.write_string(", ", !IO),
|
|
io.write_int(Arity, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
ResolvedFunctor = resolved_functor_constructor(ItemName),
|
|
ItemName = item_name(TypeName, Arity),
|
|
io.write_string("ctor(", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
TypeName, !IO),
|
|
io.write_string("/", !IO),
|
|
io.write_int(Arity, !IO),
|
|
io.write_string(")", !IO)
|
|
;
|
|
ResolvedFunctor = resolved_functor_field(TypeItemName, ConsItemName),
|
|
TypeItemName = item_name(TypeName, TypeArity),
|
|
ConsItemName = item_name(ConsName, ConsArity),
|
|
io.write_string("field(", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
TypeName, !IO),
|
|
io.write_string("/", !IO),
|
|
io.write_int(TypeArity, !IO),
|
|
io.write_string(", ", !IO),
|
|
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
|
|
ConsName, !IO),
|
|
io.write_string("/", !IO),
|
|
io.write_int(ConsArity, !IO),
|
|
io.write_string(")", !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
|
|
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),
|
|
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($module, $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, ModeIdItem, !Info):-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_mode_table(ModuleInfo, Modes),
|
|
mode_table_get_mode_defns(Modes, ModeDefns),
|
|
ModeId = item_name_to_mode_id(ModeIdItem),
|
|
map.lookup(ModeDefns, ModeId, ModeDefn),
|
|
find_items_used_by_mode_defn(ModeDefn, !Info).
|
|
find_items_used_by_item(inst_item, InstIdItem, !Info):-
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_inst_table(ModuleInfo, Insts),
|
|
inst_table_get_user_insts(Insts, UserInstTable),
|
|
InstId = item_name_to_inst_id(InstIdItem),
|
|
map.lookup(UserInstTable, InstId, 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(Methods),
|
|
list.foldl(find_items_used_by_class_method, Methods, !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($module, $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_method(class_method::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_method(Method, !Info) :-
|
|
Method = method_pred_or_func(_, _, ArgTypesAndModes, _, _, _, _, _, _, _,
|
|
Constraints, _),
|
|
find_items_used_by_class_context(Constraints, !Info),
|
|
list.foldl(find_items_used_by_type_and_mode, ArgTypesAndModes, !Info).
|
|
find_items_used_by_class_method(Method, !Info) :-
|
|
Method = method_pred_or_func_mode(_, _, 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, 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(_, Constraints, _, CtorArgs, _, _),
|
|
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(_, _, eqv_mode(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)
|
|
;
|
|
InstBody = abstract_inst
|
|
),
|
|
(
|
|
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($module, $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($module, $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.
|
|
%-----------------------------------------------------------------------------%
|