mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 13:23:53 +00:00
Code Issues Projects Releases Wiki Activity
Files
672f77c4ecd07daaf01217bc81c336dcf5d6aa02
mercury/compiler/recompilation.usage.m
Julien Fischer c204fac461 Replace some if-then-elses with switches. 
Estimated hours taken: 0.2
Branches: main

compiler/add_type.m:
compiler/recompilation.usage.m:
compiler/rtti_out.m:
	Replace some if-then-elses with switches.

	Use svmulti_map.set/4 in preference to multi_map.set/4
	in the presence of state variables.
2007-11-14 04:24:50 +00:00

1507 lines
57 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2007 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: 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.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
:- import_module assoc_list.
:- import_module io.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- 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, list(module_name)::in,
maybe(module_timestamps)::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.hlds_pred.
:- import_module hlds.passes_aux.
:- import_module hlds.pred_table.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module libs.timestamp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_data.
:- 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 assoc_list.
:- import_module bool.
:- import_module int.
:- import_module queue.
:- import_module solutions.
:- import_module string.
:- import_module svmap.
write_usage_file(ModuleInfo, NestedSubModules,
MaybeTimestamps, !IO) :-
module_info_get_maybe_recompilation_info(ModuleInfo,
MaybeRecompInfo),
(
MaybeRecompInfo = yes(RecompInfo),
MaybeTimestamps = yes(Timestamps)
->
globals.io_lookup_bool_option(verbose, Verbose, !IO),
maybe_write_string(Verbose,
"% Writing recompilation compilation dependency information\n",
!IO),
module_info_get_name(ModuleInfo, ModuleName),
module_name_to_file_name(ModuleName, ".used", yes, FileName, !IO),
io.open_output(FileName, FileResult, !IO),
(
FileResult = ok(Stream0),
io.set_output_stream(Stream0, OldStream, !IO),
write_usage_file_2(ModuleInfo,
NestedSubModules, RecompInfo, Timestamps, !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)
)
;
true
).
:- pred write_usage_file_2(module_info::in,
list(module_name)::in, recompilation_info::in,
module_timestamps::in, io::di, io::uo) is det.
write_usage_file_2(ModuleInfo, NestedSubModules, RecompInfo, Timestamps,
!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(Timestamps, 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 ^ used_items,
find_all_used_imported_items(ModuleInfo,
UsedItems, RecompInfo ^ dependencies, ResolvedUsedItems,
UsedClasses, ImportedItems, ModuleInstances),
( UsedItems = init_used_items ->
io.write_string("used_items.\n", !IO)
;
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)
),
( set.empty(UsedClasses) ->
io.write_string("used_classes.\n", !IO)
;
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, Timestamps,
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_timestamps::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, Timestamps, ModuleInstances,
ModuleName, ModuleUsedItems, !IO) :-
io.nl(!IO),
io.write_string("(", !IO),
mercury_output_bracketed_sym_name(ModuleName, !IO),
io.write_string(", """, !IO),
map.lookup(Timestamps, ModuleName,
module_timestamp(Suffix, ModuleTimestamp, NeedQualifier)),
io.write_string(Suffix, !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)
),
(
% XXX We don't yet record all uses of items from these modules
% in polymorphism.m, etc.
\+ any_mercury_builtin_module(ModuleName),
map.search(RecompInfo ^ version_numbers, ModuleName, ModuleVersions)
->
% 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),
( map.search(ModuleInstances, ModuleName, ModuleUsedInstances) ->
map.select(ModuleInstanceVersions, ModuleUsedInstances,
ModuleUsedInstanceVersions)
;
map.init(ModuleUsedInstanceVersions)
),
io.write_string(" => ", !IO),
ModuleUsedVersionNumbers =
version_numbers(ModuleUsedItemVersions,
ModuleUsedInstanceVersions),
write_version_numbers(ModuleUsedVersionNumbers, !IO),
io.write_string(".\n", !IO)
;
% 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),
( map.is_empty(Ids) ->
true
;
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(unqualified(Name), next_to_graphic_token,
!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),
( Qualifier = ModuleName ->
true
;
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),
( map.is_empty(Ids) ->
true
;
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),
( ModuleNames = [Qualifier] ->
true
;
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) :-
( map.is_empty(Ids) ->
true
;
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(TypeName, next_to_graphic_token,
!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(TypeName, next_to_graphic_token,
!IO),
io.write_string("/", !IO),
io.write_int(TypeArity, !IO),
io.write_string(", ", !IO),
mercury_output_bracketed_sym_name(ConsName, next_to_graphic_token,
!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 visible_modules(module_info::in, module_name::out) is nondet.
visible_modules(ModuleInfo, VisibleModule) :-
visible_module(VisibleModule, ModuleInfo),
\+ module_info_get_name(ModuleInfo, VisibleModule).
:- 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 set rather than det_insert as this routine may be
% called multiple times with the same VisibleModule
% depending on why the module is visible.
% eg it's both imported and an ancestor module
%
svmap.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.
map.init(ImportedItems0),
promise_equivalent_solutions [ImportedItems1] (
solutions.unsorted_aggregate(visible_modules(ModuleInfo),
insert_into_imported_items_map, 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 = !.Info ^ item_queue := queue.init,
process_imported_item_queue_2(Queue0, !Info),
Queue = !.Info ^ item_queue,
( queue.is_empty(Queue) ->
true
;
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(Queue0, !Info) :-
( queue.get(Queue0, Item, Queue) ->
Item = item_id(ItemType, ItemId),
find_items_used_by_item(ItemType, ItemId, !Info),
process_imported_item_queue_2(Queue, !Info)
;
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),
ItemSet = update_pred_or_func_set(ItemSet0, ItemType, IdSet),
!:Info = !.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_search_pf_sym_arity(PredTable,
may_be_partially_qualified, PredOrFunc, SymName,
OrigArity, 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)),
svmap.det_insert(ModuleQualifier, PredModules, !MatchingNames),
Name = unqualify_name(SymName),
set.fold(find_items_used_by_pred(PredOrFunc, Name - Arity),
PredModules, !Info)
;
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 = !.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),
( set.empty(MatchingCtors) ->
Recorded = no
;
Recorded = yes,
svmap.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),
( map.search(Ctors, cons(SymName, Arity), ConsDefns0) ->
ConsDefns1 = ConsDefns0
;
ConsDefns1 = []
),
(
remove_new_prefix(SymName, SymNameMinusNew),
map.search(Ctors, cons(SymNameMinusNew, Arity), ConsDefns2)
->
ConsDefns = list.append(ConsDefns1, ConsDefns2)
;
ConsDefns = ConsDefns1
),
MatchingConstructors =
list.map(
(func(ConsDefn) = Ctor :-
ConsDefn = hlds_cons_defn(_,_,_, 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_search_sym(PredicateTable,
may_be_partially_qualified, SymName, PredIds)
->
MatchingPreds = list.filter_map(
get_pred_or_func_ctors(ModuleInfo, SymName, Arity),
PredIds)
;
MatchingPreds = []
),
% Is it a field access function.
(
is_field_access_function_name(ModuleInfo, SymName, Arity,
_, FieldName),
module_info_get_ctor_field_table(ModuleInfo, CtorFields),
map.search(CtorFields, FieldName, FieldDefns)
->
MatchingFields = list.map(
(func(FieldDefn) = FieldCtor :-
FieldDefn = hlds_ctor_field_defn(_, _, TypeCtor, ConsId, _),
( ConsId = cons(ConsName, ConsArity) ->
FieldCtor = resolved_functor_field(
type_ctor_to_item_name(TypeCtor),
item_name(ConsName, ConsArity))
;
unexpected(this_file, "weird cons_id in hlds_field_defn")
)
), FieldDefns)
;
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),
( map.search(!.IdSet, UnqualifiedName, MatchingNames0) ->
MatchingNames1 = MatchingNames0
;
MatchingNames1 = []
),
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem,
Recorded, MatchingNames1, MatchingNames, !Info),
(
Recorded = yes,
svmap.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],
( Arity < ThisArity ->
map.init(NewArityMap0),
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
Recorded, NewArityMap0, NewArityMap, !Info),
(
Recorded = yes,
!:List = [Arity - NewArityMap | !.List]
;
Recorded = no
)
; Arity = ThisArity ->
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
Recorded, ArityMap0, ArityMap, !Info),
(
Recorded = yes,
!:List = [Arity - ArityMap | ListRest0]
;
Recorded = no
)
;
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) :-
( map.contains(!.ResolvedMap, ModuleQualifier) ->
Recorded = no
;
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, Types),
TypeCtor = item_name_to_type_ctor(TypeCtorItem),
map.lookup(Types, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
( TypeBody = hlds_eqv_type(Type) ->
% If we use an equivalence type we also use the type
% it is equivalent to.
find_items_used_by_type(Type, !Info)
;
true
).
find_items_used_by_item(type_body_item, TypeCtorItem, !Info) :-
ModuleInfo = !.Info ^ module_info,
module_info_get_type_table(ModuleInfo, Types),
TypeCtor = item_name_to_type_ctor(TypeCtorItem),
map.lookup(Types, 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, UserInsts),
user_inst_table_get_inst_defns(UserInsts, UserInstDefns),
InstId = item_name_to_inst_id(InstIdItem),
map.lookup(UserInstDefns, 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 ^ class_supers,
ClassInterface = ClassDefn ^ class_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),
( map.search(Instances, ClassId, InstanceDefns) ->
list.foldl(find_items_used_by_instance(ClassItemId), InstanceDefns,
!Info)
;
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(this_file, "find_items_used_by_item: 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),
( item_is_local(!.Info, ClassIdItem) ->
record_expanded_items_used_by_item(typeclass_item, ClassIdItem, !Info),
list.foldl(find_items_used_by_instance(ClassIdItem), InstanceDefns,
!Info)
;
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) :-
Defn = hlds_instance_defn(InstanceModuleName, _, _, Constraints,
ArgTypes, _, _, _, _),
% 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,
( module_info_get_name(ModuleInfo, InstanceModuleName) ->
true
;
find_items_used_by_class_constraints(Constraints, !Info),
find_items_used_by_types(ArgTypes, !Info),
ModuleInstances0 = !.Info ^ module_instances,
( map.search(ModuleInstances0, InstanceModuleName, ClassIdsPrime) ->
ClassIds1 = ClassIdsPrime
;
set.init(ClassIds1)
),
set.insert(ClassIds1, ClassId, ClassIds),
map.set(ModuleInstances0, InstanceModuleName, ClassIds,
ModuleInstances),
!:Info = !.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(hlds_du_type(Ctors, _, _, _, _, _, _), !Info) :-
list.foldl(find_items_used_by_ctor, Ctors, !Info).
find_items_used_by_type_body(hlds_eqv_type(Type), !Info) :-
find_items_used_by_type(Type, !Info).
find_items_used_by_type_body(hlds_abstract_type(_), !Info).
find_items_used_by_type_body(hlds_foreign_type(_), !Info).
% rafe: XXX Should we trace the representation type?
find_items_used_by_type_body(hlds_solver_type(_, _), !Info).
:- 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, _, _),
(
InstBody = eqv_inst(Inst),
find_items_used_by_inst(Inst, !Info)
;
InstBody = abstract_inst
).
:- 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),
(
ItemName = item_name(qualified(PredModule, Name), Arity),
(
item_is_recorded_used(!.Info, ItemType, ItemName)
;
item_is_local(!.Info, ItemName)
)
->
% We've already recorded the items used by this predicate.
true
;
% 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)
->
% 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 = [constraint(ClassName0, ClassArgs) | _] ->
ClassName = ClassName0,
ClassArity = list.length(ClassArgs)
;
unexpected(this_file, "class method with no class constraints")
),
maybe_record_item_to_process(typeclass_item,
item_name(ClassName, ClassArity), !Info)
;
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_procedures(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),
( map.search(PragmaMap, PredId, TypeSpecPragmas) ->
list.foldl(find_items_used_by_type_spec, TypeSpecPragmas, !Info)
;
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_type::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
find_items_used_by_type_spec(Pragma, !Info) :-
( Pragma = pragma_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)
;
unexpected(this_file,
"find_items_used_by_type_spec: unexpected pragma type")
).
:- 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) :-
( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
(
% Unqualified type constructor names are builtins.
TypeCtor = type_ctor(qualified(_, _), _),
\+ type_ctor_is_higher_order(TypeCtor, _, _, _)
->
TypeCtorItem = type_ctor_to_item_name(TypeCtor),
maybe_record_item_to_process(type_abstract_item, TypeCtorItem,
!Info)
;
true
),
find_items_used_by_types(TypeArgs, !Info)
;
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((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(any(_), !Info).
find_items_used_by_inst(free, !Info).
find_items_used_by_inst(free(_), !Info).
find_items_used_by_inst(bound(_, BoundInsts), !Info) :-
list.foldl(find_items_used_by_bound_inst, BoundInsts, !Info).
find_items_used_by_inst(ground(_, GroundInstInfo), !Info) :-
(
GroundInstInfo = higher_order(pred_inst_info(_, Modes, _)),
find_items_used_by_modes(Modes, !Info)
;
GroundInstInfo = none
).
find_items_used_by_inst(not_reached, !Info).
find_items_used_by_inst(inst_var(_), !Info).
find_items_used_by_inst(constrained_inst_vars(_, Inst), !Info) :-
find_items_used_by_inst(Inst, !Info).
find_items_used_by_inst(defined_inst(InstName), !Info) :-
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst(abstract_inst(Name, ArgInsts), !Info) :-
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),
( ConsId = cons(Name, Arity) ->
record_used_functor(Name - Arity, !Info)
;
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(user_inst(Name, ArgInsts), !Info) :-
list.length(ArgInsts, Arity),
maybe_record_item_to_process(inst_item, item_name(Name, Arity), !Info),
find_items_used_by_insts(ArgInsts, !Info).
find_items_used_by_inst_name(merge_inst(Inst1, Inst2), !Info) :-
find_items_used_by_inst(Inst1, !Info),
find_items_used_by_inst(Inst2, !Info).
find_items_used_by_inst_name(unify_inst(_, Inst1, Inst2, _), !Info) :-
find_items_used_by_inst(Inst1, !Info),
find_items_used_by_inst(Inst2, !Info).
find_items_used_by_inst_name(ground_inst(InstName, _, _, _), !Info) :-
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst_name(any_inst(InstName, _, _, _), !Info) :-
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst_name(shared_inst(InstName), !Info) :-
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst_name(mostly_uniq_inst(InstName), !Info) :-
find_items_used_by_inst_name(InstName, !Info).
find_items_used_by_inst_name(typed_ground(_, Type), !Info) :-
find_items_used_by_type(Type, !Info).
find_items_used_by_inst_name(typed_inst(Type, InstName), !Info) :-
find_items_used_by_type(Type, !Info),
find_items_used_by_inst_name(InstName, !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(ClassName, ArgTypes), !Info) :-
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) :-
( ItemType = typeclass_item ->
Classes0 = !.Info ^ used_typeclasses,
set.insert(Classes0, ItemName, Classes),
!:Info = !.Info ^ used_typeclasses := Classes
;
true
),
( item_is_recorded_used(!.Info, ItemType, ItemName) ->
% This item has already been recorded.
true
; item_is_local(!.Info, ItemName) ->
% Ignore local items. The items used by them have already been recorded
% by module_qual.m.
true
;
Queue0 = !.Info ^ item_queue,
queue.put(Queue0, item_id(ItemType, ItemName), Queue),
!:Info = !.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
;
unexpected(this_file, "maybe_record_item_to_process: unqualified item")
),
ImportedItems0 = !.Info ^ imported_items,
( map.search(ImportedItems0, Module, ModuleItems0) ->
ModuleItems1 = ModuleItems0
;
ModuleItems1 = init_item_id_set(set.init)
),
ModuleItemIds0 = extract_ids(ModuleItems1, ItemType),
set.insert(ModuleItemIds0, Name - Arity, ModuleItemIds),
ModuleItems = update_ids(ModuleItems1, ItemType, ModuleItemIds),
map.set(ImportedItems0, Module, ModuleItems, ImportedItems),
!:Info = !.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,
(
map.search(Dependencies, item_id(ItemType, NameArity), EquivTypes)
->
list.foldl(record_expanded_items_used_by_item_2,
set.to_sorted_list(EquivTypes), !Info)
;
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).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "recompilation.usage.m".
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink