mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
compiler/prog_type_construct.m:
New module for constructing types.
compiler/prog_type_repn.m:
New module for testing things related to type representation.
compiler/prog_type_scan.m:
New module for gather type vars in types.
compiler/prog_type_test.m:
New module containing simple tests on types.
compiler/prog_type_unify.m:
New module for testing whether two types unify, or whether
one type subsumes another.
compiler/prog_type.m:
Delete the code moved to the new modules.
compiler/parse_tree.m:
Include the new modules.
compiler/notes/compiler_design.html:
Document the new modules.
compiler/*.m:
Conform to the changes above, by adjusting imports as needed,
and by deleting any explicit module qualifications that
this diff makes obsolete.
1204 lines
47 KiB
Mathematica
1204 lines
47 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 parse_tree.
|
|
:- import_module parse_tree.module_baggage.
|
|
:- import_module recompilation.used_file.
|
|
|
|
:- pred construct_used_file_contents(module_info::in, recompilation_info::in,
|
|
maybe_top_module::in, module_timestamp_map::in,
|
|
used_file_contents::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_class.
|
|
:- import_module hlds.hlds_cons.
|
|
:- import_module hlds.hlds_data.
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_item.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_test.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module int.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module one_or_more.
|
|
:- import_module pair.
|
|
:- import_module queue.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
construct_used_file_contents(ModuleInfo, RecompInfo, MaybeTopModule,
|
|
TimestampMap, Contents) :-
|
|
% Go over the set of imported items found to be used and
|
|
% find the transitive closure of the imported items they use.
|
|
|
|
% 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 = RecompInfo ^ recomp_used_items,
|
|
UsedItems = used_items(TypeNames, TypeDefns, Insts, Modes, Classes,
|
|
_, _, _),
|
|
map.init(ResolvedCtors),
|
|
map.init(ResolvedPreds),
|
|
map.init(ResolvedFuncs),
|
|
ResolvedUsedItems0 = resolved_used_items(TypeNames, TypeDefns,
|
|
Insts, Modes, Classes, ResolvedCtors, ResolvedPreds, ResolvedFuncs),
|
|
|
|
Dependencies = RecompInfo ^ recomp_dependencies,
|
|
Info0 = recompilation_usage_info(ModuleInfo, ItemsToProcess0,
|
|
ImportedItems1, ModuleUsedClasses, Dependencies,
|
|
ResolvedUsedItems0, UsedClasses0),
|
|
|
|
find_all_used_imported_items(UsedItems, Info0, Info),
|
|
|
|
ImportedItems = Info ^ imported_items,
|
|
ModuleInstances = Info ^ module_instances,
|
|
UsedTypeClasses = Info ^ used_typeclasses,
|
|
ResolvedUsedItems = Info ^ resolved_used_items,
|
|
|
|
ModuleItemVersionNumbersMap = RecompInfo ^ recomp_version_numbers,
|
|
Contents = used_file_contents(ModuleName, MaybeTopModule, TimestampMap,
|
|
ModuleItemVersionNumbersMap,
|
|
ResolvedUsedItems, UsedTypeClasses, ImportedItems, ModuleInstances).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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 = module_imported_items(set.init, set.init, set.init,
|
|
set.init, set.init, set.init, set.init,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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type recompilation_usage_info
|
|
---> recompilation_usage_info(
|
|
module_info :: module_info,
|
|
item_queue :: queue(recomp_item_id),
|
|
imported_items :: imported_items,
|
|
module_instances :: map(module_name, set(recomp_item_name)),
|
|
% For each module, the used typeclasses for
|
|
% which the module contains an instance.
|
|
dependencies :: map(recomp_item_id,
|
|
set(recomp_item_id)),
|
|
resolved_used_items :: resolved_used_items,
|
|
used_typeclasses :: set(recomp_item_name)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred find_all_used_imported_items(used_items::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_all_used_imported_items(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),
|
|
|
|
UsedItems = used_items(TypeNames, TypeDefns, Insts, Modes, Classes,
|
|
Functors, Predicates, Functions),
|
|
find_items_used_by_simple_item_set(recomp_type_name, TypeNames, !Info),
|
|
find_items_used_by_simple_item_set(recomp_type_defn, TypeDefns, !Info),
|
|
find_items_used_by_simple_item_set(recomp_inst, Insts, !Info),
|
|
find_items_used_by_simple_item_set(recomp_mode, Modes, !Info),
|
|
find_items_used_by_simple_item_set(recomp_typeclass, Classes, !Info),
|
|
find_items_used_by_preds(pf_predicate, Predicates, !Info),
|
|
find_items_used_by_preds(pf_function, Functions, !Info),
|
|
find_items_used_by_functors(Functors, !Info),
|
|
|
|
process_imported_item_to_fixpoint(!Info).
|
|
|
|
:- pred process_imported_item_to_fixpoint(
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
process_imported_item_to_fixpoint(!Info) :-
|
|
Queue0 = !.Info ^ item_queue,
|
|
!Info ^ item_queue := queue.init,
|
|
process_imported_items_in_queue(Queue0, !Info),
|
|
Queue = !.Info ^ item_queue,
|
|
( if queue.is_empty(Queue) then
|
|
true
|
|
else
|
|
disable_warning [suspicious_recursion] (
|
|
process_imported_item_to_fixpoint(!Info)
|
|
)
|
|
).
|
|
|
|
:- pred process_imported_items_in_queue(queue(recomp_item_id)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
process_imported_items_in_queue(!.Queue, !Info) :-
|
|
( if queue.get(Item, !Queue) then
|
|
Item = recomp_item_id(ItemType, ItemId),
|
|
find_items_used_by_item(ItemType, ItemId, !Info),
|
|
disable_warning [suspicious_recursion] (
|
|
process_imported_items_in_queue(!.Queue, !Info)
|
|
)
|
|
else
|
|
true
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred record_used_pred_or_func(pred_or_func::in, recomp_item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_used_pred_or_func(PredOrFunc, Id, !Info) :-
|
|
% XXX ARITY This Arity appears to represent a user_arity,
|
|
% but any connection to the original pred_info is so tenuous
|
|
% that I (zs) cannot be sure.
|
|
Id = recomp_item_name(SymName, Arity),
|
|
UsedItems0 = !.Info ^ resolved_used_items,
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
IdSet0 = UsedItems0 ^ rui_predicates,
|
|
record_resolved_item(SymName, Arity,
|
|
do_record_used_pred_or_func(PredOrFunc),
|
|
IdSet0, IdSet, !Info),
|
|
UsedItems = UsedItems0 ^ rui_predicates := IdSet
|
|
;
|
|
PredOrFunc = pf_function,
|
|
IdSet0 = UsedItems0 ^ rui_functions,
|
|
record_resolved_item(SymName, Arity,
|
|
do_record_used_pred_or_func(PredOrFunc),
|
|
IdSet0, IdSet, !Info),
|
|
UsedItems = UsedItems0 ^ rui_functions := IdSet
|
|
),
|
|
!Info ^ resolved_used_items := UsedItems.
|
|
|
|
:- pred do_record_used_pred_or_func(pred_or_func::in,
|
|
module_qualifier::in, sym_name::in, arity::in, maybe_recorded::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),
|
|
% XXX ARITY BUG See the comment in record_used_pred_or_func about Arity,
|
|
% which makes this adjustment look *very* strange. Since the pred form
|
|
% arity is supposed to be the *last* argument of adjust_func_arity,
|
|
% I (zs) strongly suspect that this call should be
|
|
% adjust_func_arity(PredOrFunc, Arity, PredFormArityInt),
|
|
adjust_func_arity(PredOrFunc, PredFormArityInt, Arity),
|
|
PredFormArity = pred_form_arity(PredFormArityInt),
|
|
predicate_table_lookup_pf_sym_arity(PredTable, may_be_partially_qualified,
|
|
PredOrFunc, SymName, PredFormArity, MatchingPredIds),
|
|
(
|
|
MatchingPredIds = [_ | _],
|
|
Recorded = recorded,
|
|
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),
|
|
NameArity = name_arity(unqualify_name(SymName), Arity),
|
|
set.fold(find_items_used_by_pred(PredOrFunc, NameArity),
|
|
PredModules, !Info)
|
|
;
|
|
MatchingPredIds = [],
|
|
Recorded = not_recorded
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- 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) :-
|
|
UsedItems0 = !.Info ^ resolved_used_items,
|
|
IdSet0 = UsedItems0 ^ rui_functors,
|
|
record_resolved_item(SymName, Arity, do_record_used_functor,
|
|
IdSet0, IdSet, !Info),
|
|
UsedItems = UsedItems0 ^ rui_functors := IdSet,
|
|
!Info ^ resolved_used_items := UsedItems.
|
|
|
|
:- pred do_record_used_functor(module_qualifier::in,
|
|
sym_name::in, arity::in, maybe_recorded::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 = not_recorded
|
|
else
|
|
Recorded = recorded,
|
|
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
|
|
),
|
|
MatchingConstructorRFs =
|
|
list.map(
|
|
( func(ConsDefn) = Ctor :-
|
|
ConsDefn ^ cons_type_ctor = TypeCtor,
|
|
Ctor = resolved_functor_data_constructor(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),
|
|
list.filter_map(
|
|
can_resolve_pred_or_func(ModuleInfo, SymName, Arity),
|
|
PredIds, MatchingPredRFs),
|
|
|
|
% 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
|
|
MatchingFieldAccessRFs = list.map(
|
|
( func(FieldDefn) = FieldAccessRF :-
|
|
FieldDefn =
|
|
hlds_ctor_field_defn(_, _, TypeCtor, FieldConsId, _),
|
|
( if FieldConsId = cons(ConsName, ConsArity, _) then
|
|
ConsCtor = cons_ctor(ConsName, ConsArity, TypeCtor),
|
|
FieldAccessRF =
|
|
resolved_functor_field_access_func(ConsCtor)
|
|
else
|
|
unexpected($pred, "weird cons_id in hlds_field_defn")
|
|
)
|
|
), FieldDefns)
|
|
else
|
|
MatchingFieldAccessRFs = []
|
|
),
|
|
ResolvedConstructors = set.list_to_set(list.condense(
|
|
[MatchingConstructorRFs, MatchingPredRFs, MatchingFieldAccessRFs])).
|
|
|
|
:- pred can_resolve_pred_or_func(module_info::in, sym_name::in, arity::in,
|
|
pred_id::in, resolved_functor::out) is semidet.
|
|
|
|
can_resolve_pred_or_func(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),
|
|
pred_info_get_orig_arity(PredInfo, OrigPredFormArity),
|
|
user_arity_pred_form_arity(PredOrFunc, OrigUserArity, OrigPredFormArity),
|
|
OrigUserArity = user_arity(OrigUserArityInt),
|
|
pred_info_get_exist_quant_tvars(PredInfo, PredExistQVars),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
OrigUserArityInt >= Arity,
|
|
% We don't support first-class polymorphism, so you can't take
|
|
% the address of an existentially quantified predicate.
|
|
PredExistQVars = []
|
|
;
|
|
PredOrFunc = pf_function,
|
|
OrigUserArityInt >= 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 = []
|
|
; OrigUserArityInt = Arity
|
|
)
|
|
),
|
|
% XXX We are asserting that OrigUserArityInt, which is a user arity,
|
|
% is a pred_form_arity. This means that for functions, the arity
|
|
% we record here will be incorrect.
|
|
ResolvedCtor = resolved_functor_pred_or_func(PredId, PredOrFunc,
|
|
PredModule, pred_form_arity(OrigUserArityInt)).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_recorded
|
|
---> not_recorded
|
|
; recorded.
|
|
|
|
:- type record_item_pred(T) ==
|
|
pred(module_qualifier, sym_name, arity, maybe_recorded,
|
|
resolved_item_map(T), resolved_item_map(T),
|
|
recompilation_usage_info, recompilation_usage_info).
|
|
:- inst record_item_pred ==
|
|
(pred(in, in, in, out, in, out, in, out) is det).
|
|
|
|
:- pred record_resolved_item(sym_name::in, arity::in,
|
|
record_item_pred(T)::in(record_item_pred),
|
|
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 = recorded,
|
|
map.set(UnqualifiedName, MatchingNames, !IdSet)
|
|
;
|
|
Recorded = not_recorded
|
|
).
|
|
|
|
:- pred record_resolved_item_2(module_qualifier::in, sym_name::in, arity::in,
|
|
record_item_pred(T)::in(record_item_pred), maybe_recorded::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 = recorded,
|
|
!:List = [Arity - Map]
|
|
;
|
|
Recorded = not_recorded
|
|
).
|
|
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 = recorded,
|
|
!:List = [Arity - NewArityMap | !.List]
|
|
;
|
|
Recorded = not_recorded
|
|
)
|
|
else if Arity = ThisArity then
|
|
record_resolved_item_3(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, ArityMap0, ArityMap, !Info),
|
|
(
|
|
Recorded = recorded,
|
|
!:List = [Arity - ArityMap | ListRest0]
|
|
;
|
|
Recorded = not_recorded
|
|
)
|
|
else
|
|
record_resolved_item_2(ModuleQualifier, SymName, Arity, RecordItem,
|
|
Recorded, ListRest0, ListRest, !Info),
|
|
(
|
|
Recorded = recorded,
|
|
!:List = [ThisArity - ArityMap0 | ListRest]
|
|
;
|
|
Recorded = not_recorded
|
|
)
|
|
).
|
|
|
|
:- pred record_resolved_item_3(module_qualifier::in, sym_name::in, arity::in,
|
|
record_item_pred(T)::in(record_item_pred), maybe_recorded::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 = not_recorded
|
|
else
|
|
RecordItem(ModuleQualifier, SymName, Arity, Recorded,
|
|
!ResolvedMap, !Info)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred find_items_used_by_item(recomp_item_type::in, recomp_item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_item(ItemType, ItemName, !Info) :-
|
|
(
|
|
ItemType = recomp_type_name,
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
TypeCtor = recomp_item_name_to_type_ctor(ItemName),
|
|
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
|
|
)
|
|
;
|
|
ItemType = recomp_type_defn,
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_type_table(ModuleInfo, TypeTable),
|
|
TypeCtor = recomp_item_name_to_type_ctor(ItemName),
|
|
lookup_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
|
|
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
|
|
find_items_used_by_type_body(TypeBody, !Info)
|
|
;
|
|
ItemType = recomp_inst,
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_inst_table(ModuleInfo, Insts),
|
|
inst_table_get_user_insts(Insts, UserInstTable),
|
|
InstCtor = recomp_item_name_to_inst_ctor(ItemName),
|
|
map.lookup(UserInstTable, InstCtor, InstDefn),
|
|
find_items_used_by_inst_defn(InstDefn, !Info)
|
|
;
|
|
ItemType = recomp_mode,
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_mode_table(ModuleInfo, Modes),
|
|
mode_table_get_mode_defns(Modes, ModeDefns),
|
|
ModeCtor = recomp_item_name_to_mode_ctor(ItemName),
|
|
map.lookup(ModeDefns, ModeCtor, ModeDefn),
|
|
find_items_used_by_mode_defn(ModeDefn, !Info)
|
|
;
|
|
ItemType = recomp_typeclass,
|
|
ItemName = recomp_item_name(ClassName, ClassArity),
|
|
ClassId = class_id(ClassName, ClassArity),
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_get_class_table(ModuleInfo, Classes),
|
|
map.lookup(Classes, ClassId, ClassDefn),
|
|
Constraints = ClassDefn ^ classdefn_supers,
|
|
ClassInterface = ClassDefn ^ classdefn_interface,
|
|
find_items_used_by_class_constraints(Constraints, !Info),
|
|
(
|
|
ClassInterface = class_interface_abstract
|
|
;
|
|
ClassInterface = class_interface_concrete(ClassDecls),
|
|
list.foldl(find_items_used_by_class_decl, ClassDecls, !Info)
|
|
),
|
|
module_info_get_instance_table(ModuleInfo, Instances),
|
|
( if map.search(Instances, ClassId, InstanceDefns) then
|
|
list.foldl(find_items_used_by_instance(ItemName), InstanceDefns,
|
|
!Info)
|
|
else
|
|
true
|
|
)
|
|
;
|
|
ItemType = recomp_predicate,
|
|
record_used_pred_or_func(pf_predicate, ItemName, !Info)
|
|
;
|
|
ItemType = recomp_function,
|
|
record_used_pred_or_func(pf_function, ItemName, !Info)
|
|
;
|
|
ItemType = recomp_functor,
|
|
unexpected($pred, "functor")
|
|
;
|
|
( ItemType = recomp_mutable
|
|
; ItemType = recomp_foreign_proc
|
|
)
|
|
% XXX What should be done here???
|
|
% 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 = recomp_item_name(Name, Arity),
|
|
( if item_is_local(!.Info, ClassIdItem) then
|
|
record_expanded_items_used_by_item(recomp_typeclass, ClassIdItem,
|
|
!Info),
|
|
list.foldl(find_items_used_by_instance(ClassIdItem), InstanceDefns,
|
|
!Info)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred find_items_used_by_instance(recomp_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, _, _,
|
|
_OriginalArgTypes, ArgTypes, Constraints, _, _, _, _, _),
|
|
% XXX Handle interface (currently not needed because the interfaces
|
|
% for imported instances are only needed with --intermodule-optimization,
|
|
% which isn't handled here yet).
|
|
ModuleInfo = !.Info ^ module_info,
|
|
( if module_info_get_name(ModuleInfo, InstanceModuleName) then
|
|
true
|
|
else
|
|
find_items_used_by_class_constraints(Constraints, !Info),
|
|
find_items_used_by_types(ArgTypes, !Info),
|
|
ModuleInstances0 = !.Info ^ module_instances,
|
|
( if
|
|
map.search(ModuleInstances0, InstanceModuleName, ClassIdsPrime)
|
|
then
|
|
ClassIds1 = ClassIdsPrime
|
|
else
|
|
set.init(ClassIds1)
|
|
),
|
|
set.insert(ClassId, ClassIds1, ClassIds),
|
|
map.set(InstanceModuleName, ClassIds,
|
|
ModuleInstances0, ModuleInstances),
|
|
!Info ^ module_instances := ModuleInstances
|
|
).
|
|
|
|
:- pred find_items_used_by_class_decl(class_decl::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_class_decl(Decl, !Info) :-
|
|
(
|
|
Decl = class_decl_pred_or_func(PredOrFuncInfo),
|
|
PredOrFuncInfo = class_pred_or_func_info(_, _, ArgTypesAndModes,
|
|
_, _, _, _, _, _, _, Constraints, _),
|
|
find_items_used_by_class_context(Constraints, !Info),
|
|
list.foldl(find_items_used_by_type_and_mode, ArgTypesAndModes, !Info)
|
|
;
|
|
Decl = class_decl_mode(ModeInfo),
|
|
ModeInfo = class_mode_info(_, _, Modes, _, _, _, _),
|
|
find_items_used_by_modes(Modes, !Info)
|
|
).
|
|
|
|
:- pred find_items_used_by_type_and_mode(type_and_mode::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_and_mode(TypeAndMode, !Info) :-
|
|
(
|
|
TypeAndMode = type_only(Type)
|
|
;
|
|
TypeAndMode = type_and_mode(Type, Mode),
|
|
find_items_used_by_mode(Mode, !Info)
|
|
),
|
|
find_items_used_by_type(Type, !Info).
|
|
|
|
:- pred find_items_used_by_type_body(hlds_type_body::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_body(TypeBody, !Info) :-
|
|
(
|
|
TypeBody = hlds_du_type(TypeBodyDu),
|
|
TypeBodyDu = type_body_du(Ctors, MaybeSuperType, _, _, _),
|
|
(
|
|
MaybeSuperType = subtype_of(SuperType),
|
|
find_items_used_by_type(SuperType, !Info)
|
|
;
|
|
MaybeSuperType = not_a_subtype
|
|
),
|
|
list.foldl(find_items_used_by_ctor, one_or_more_to_list(Ctors), !Info)
|
|
;
|
|
TypeBody = hlds_eqv_type(EqvType),
|
|
find_items_used_by_type(EqvType, !Info)
|
|
;
|
|
( TypeBody = hlds_abstract_type(_)
|
|
; TypeBody = hlds_foreign_type(_)
|
|
)
|
|
;
|
|
TypeBody = hlds_solver_type(_)
|
|
% rafe: XXX Should we trace the representation type?
|
|
).
|
|
|
|
:- pred find_items_used_by_ctor(constructor::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_ctor(Ctor, !Info) :-
|
|
Ctor = ctor(_, MaybeExistConstraints, _, CtorArgs, _, _),
|
|
(
|
|
MaybeExistConstraints = no_exist_constraints
|
|
;
|
|
MaybeExistConstraints = exist_constraints(ExistConstraints),
|
|
ExistConstraints = cons_exist_constraints(_, Constraints, _, _),
|
|
find_items_used_by_class_constraints(Constraints, !Info)
|
|
),
|
|
list.foldl(find_items_used_by_ctor_arg, CtorArgs, !Info).
|
|
|
|
:- pred find_items_used_by_ctor_arg(constructor_arg::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_ctor_arg(CtorArg, !Info) :-
|
|
ArgType = CtorArg ^ arg_type,
|
|
find_items_used_by_type(ArgType, !Info).
|
|
|
|
:- pred find_items_used_by_mode_defn(hlds_mode_defn::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_mode_defn(Defn, !Info) :-
|
|
Defn = hlds_mode_defn(_, _, hlds_mode_body(Mode), _, _),
|
|
find_items_used_by_mode(Mode, !Info).
|
|
|
|
:- pred find_items_used_by_inst_defn(hlds_inst_defn::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_inst_defn(Defn, !Info) :-
|
|
Defn = hlds_inst_defn(_, _, InstBody, IFTC, _, _),
|
|
InstBody = eqv_inst(Inst),
|
|
find_items_used_by_inst(Inst, !Info),
|
|
(
|
|
IFTC = iftc_applicable_declared(ForTypeCtor),
|
|
find_items_used_by_type_ctor(ForTypeCtor, !Info)
|
|
;
|
|
IFTC = iftc_applicable_known(MatchingTypeCtors),
|
|
list.foldl(find_items_used_by_type_ctor, MatchingTypeCtors, !Info)
|
|
;
|
|
( IFTC = iftc_not_bound_inst
|
|
; IFTC = iftc_applicable_not_known
|
|
; IFTC = iftc_applicable_error_unknown_type
|
|
; IFTC = iftc_applicable_error_eqv_type(_)
|
|
; IFTC = iftc_applicable_error_visibility(_)
|
|
; IFTC = iftc_applicable_error_mismatches(_)
|
|
)
|
|
).
|
|
|
|
:- pred find_items_used_by_preds(pred_or_func::in, simple_item_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,
|
|
name_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, NameArity, MatchingPredMap, !Info) :-
|
|
NameArity = name_arity(Name, Arity),
|
|
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),
|
|
ItemName = recomp_item_name(SymName, Arity),
|
|
record_used_pred_or_func(PredOrFunc, ItemName, !Info).
|
|
|
|
:- pred find_items_used_by_pred(pred_or_func::in,
|
|
name_arity::in, pair(pred_id, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_pred(PredOrFunc, NameArity, PredId - PredModule, !Info) :-
|
|
ItemType = pred_or_func_to_recomp_item_type(PredOrFunc),
|
|
ModuleInfo = !.Info ^ module_info,
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
NameArity = name_arity(Name, Arity),
|
|
( if
|
|
ItemName = recomp_item_name(qualified(PredModule, Name), Arity),
|
|
(
|
|
item_is_recorded_used(!.Info, ItemType, ItemName)
|
|
;
|
|
item_is_local(!.Info, ItemName)
|
|
)
|
|
then
|
|
% We have already recorded the items used by this predicate.
|
|
true
|
|
else if
|
|
% Items used by class methods are recorded when processing
|
|
% the typeclass declaration. Make sure that is done.
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
check_marker(Markers, marker_class_method)
|
|
then
|
|
% The typeclass for which the predicate is a method is the first
|
|
% of the universal class constraints in the pred_info.
|
|
pred_info_get_class_context(PredInfo, MethodClassContext),
|
|
MethodClassContext = constraints(MethodUnivConstraints, _),
|
|
(
|
|
MethodUnivConstraints = [MethodUnivConstraint | _],
|
|
MethodUnivConstraint = constraint(ClassName, ClassArgTypes),
|
|
ClassArity = list.length(ClassArgTypes)
|
|
;
|
|
MethodUnivConstraints = [],
|
|
unexpected($pred, "class method with no class constraints")
|
|
),
|
|
ClassItemName = recomp_item_name(ClassName, ClassArity),
|
|
maybe_record_item_to_process(recomp_typeclass, ClassItemName, !Info)
|
|
else
|
|
ItemName = recomp_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(decl_pragma_type_spec_info::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_type_spec(TypeSpecInfo, !Info) :-
|
|
TypeSpecInfo = decl_pragma_type_spec_info(PFUMM, _, _, Subst, _, _, _, _),
|
|
(
|
|
( PFUMM = pfumm_predicate(ModesOrArity)
|
|
; PFUMM = pfumm_function(ModesOrArity)
|
|
),
|
|
(
|
|
ModesOrArity = moa_modes(Modes),
|
|
find_items_used_by_modes(Modes, !Info)
|
|
;
|
|
ModesOrArity = moa_arity(_Arity)
|
|
)
|
|
;
|
|
PFUMM = pfumm_unknown(_Arity)
|
|
),
|
|
assoc_list.values(one_or_more_to_list(Subst), SubstTypes),
|
|
find_items_used_by_types(SubstTypes, !Info).
|
|
|
|
:- pred find_items_used_by_functors(simple_item_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(name_arity::in,
|
|
map(module_qualifier, module_name)::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
find_items_used_by_functors_2(NameArity, MatchingCtorMap, !Info) :-
|
|
NameArity = name_arity(Name, Arity),
|
|
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, PredOrFunc,
|
|
PredModule, pred_form_arity(PredFormArity)),
|
|
NameArity = name_arity(Name, PredFormArity),
|
|
find_items_used_by_pred(PredOrFunc, NameArity, PredId - PredModule,
|
|
!Info)
|
|
;
|
|
(
|
|
ResolverFunctor = resolved_functor_data_constructor(TypeCtor)
|
|
;
|
|
ResolverFunctor = resolved_functor_field_access_func(ConsCtor),
|
|
ConsCtor = cons_ctor(_ConsName, _ConsArity, TypeCtor)
|
|
),
|
|
ItemName = type_ctor_to_recomp_item_name(TypeCtor),
|
|
maybe_record_item_to_process(recomp_type_defn, ItemName, !Info)
|
|
).
|
|
|
|
:- pred find_items_used_by_simple_item_set(recomp_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(recomp_item_type::in,
|
|
name_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, NameArity, MatchingIdMap,
|
|
!Info) :-
|
|
NameArity = name_arity(Name, Arity),
|
|
map.foldl(find_items_used_by_simple_item_set_3(ItemType, Name, Arity),
|
|
MatchingIdMap, !Info).
|
|
|
|
:- pred find_items_used_by_simple_item_set_3(recomp_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,
|
|
recomp_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_recomp_item_name(TypeCtor),
|
|
maybe_record_item_to_process(recomp_type_name, 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) :-
|
|
ItemName = recomp_item_name(ModeName, list.length(ArgInsts)),
|
|
maybe_record_item_to_process(recomp_mode, ItemName, !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 = 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)
|
|
).
|
|
|
|
:- 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),
|
|
ItemName = recomp_item_name(Name, list.length(ArgInsts)),
|
|
maybe_record_item_to_process(recomp_inst, ItemName, !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, !Info) :-
|
|
Constraints = constraints(UnivConstraints, ExistConstraints),
|
|
find_items_used_by_class_constraints(UnivConstraints, !Info),
|
|
find_items_used_by_class_constraints(ExistConstraints, !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),
|
|
ItemName = recomp_item_name(ClassName, list.length(ArgTypes)),
|
|
maybe_record_item_to_process(recomp_typeclass, ItemName, !Info),
|
|
find_items_used_by_types(ArgTypes, !Info).
|
|
|
|
:- pred maybe_record_item_to_process(recomp_item_type::in,
|
|
recomp_item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
maybe_record_item_to_process(ItemType, ItemName, !Info) :-
|
|
( if ItemType = recomp_typeclass 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(recomp_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,
|
|
recomp_item_type::in, recomp_item_name::in) is semidet.
|
|
|
|
item_is_recorded_used(Info, ItemType, ItemName) :-
|
|
ImportedItems = Info ^ imported_items,
|
|
ItemName = recomp_item_name(qualified(ModuleName, Name), Arity),
|
|
map.search(ImportedItems, ModuleName, ModuleImportedItems),
|
|
get_module_imported_items(ModuleImportedItems, ItemType, ModuleItemIdSet),
|
|
set.member(name_arity(Name, Arity), ModuleItemIdSet).
|
|
|
|
:- pred item_is_local(recompilation_usage_info::in, recomp_item_name::in)
|
|
is semidet.
|
|
|
|
item_is_local(Info, ItemName) :-
|
|
ItemName = recomp_item_name(qualified(ModuleName, _), _),
|
|
module_info_get_name(Info ^ module_info, ModuleName).
|
|
|
|
:- pred record_imported_item(recomp_item_type::in, recomp_item_name::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_imported_item(ItemType, ItemName, !Info) :-
|
|
ItemName = recomp_item_name(SymName, Arity),
|
|
(
|
|
SymName = qualified(Module0, Name0),
|
|
Module = Module0,
|
|
Name = Name0
|
|
;
|
|
SymName = unqualified(_),
|
|
unexpected($pred, "unqualified item")
|
|
),
|
|
|
|
ImportedItems0 = !.Info ^ imported_items,
|
|
( if map.search(ImportedItems0, Module, ModuleItems0) then
|
|
ModuleItems1 = ModuleItems0
|
|
else
|
|
ModuleItems1 = init_module_imported_items
|
|
),
|
|
get_module_imported_items(ModuleItems1, ItemType, ModuleItemIds0),
|
|
set.insert(name_arity(Name, Arity), ModuleItemIds0, ModuleItemIds),
|
|
set_module_imported_items(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(recomp_item_type::in,
|
|
recomp_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, recomp_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(recomp_item_id::in,
|
|
recompilation_usage_info::in, recompilation_usage_info::out) is det.
|
|
|
|
record_expanded_items_used_by_item_2(Item, !Info) :-
|
|
Item = recomp_item_id(DepItemType, DepItemId),
|
|
maybe_record_item_to_process(DepItemType, DepItemId, !Info).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- func init_module_imported_items = module_imported_items.
|
|
|
|
init_module_imported_items =
|
|
module_imported_items(set.init, set.init, set.init, set.init, set.init,
|
|
set.init, set.init, set.init).
|
|
|
|
:- pred get_module_imported_items(module_imported_items::in,
|
|
recomp_item_type::in, imported_item_set::out) is det.
|
|
|
|
get_module_imported_items(MII, recomp_type_name, MII ^ mii_type_names).
|
|
get_module_imported_items(MII, recomp_type_defn, MII ^ mii_type_defns).
|
|
get_module_imported_items(MII, recomp_inst, MII ^ mii_insts).
|
|
get_module_imported_items(MII, recomp_mode, MII ^ mii_modes).
|
|
get_module_imported_items(MII, recomp_typeclass, MII ^ mii_typeclasses).
|
|
get_module_imported_items(MII, recomp_functor, MII ^ mii_functors).
|
|
get_module_imported_items(MII, recomp_predicate, MII ^ mii_predicates).
|
|
get_module_imported_items(MII, recomp_function, MII ^ mii_functions).
|
|
get_module_imported_items(_MII, recomp_mutable, _) :-
|
|
unexpected($pred, "recomp_mutable").
|
|
get_module_imported_items(_MII, recomp_foreign_proc, _) :-
|
|
unexpected($pred, "recomp_foreign_proc").
|
|
|
|
:- pred set_module_imported_items(recomp_item_type::in, imported_item_set::in,
|
|
module_imported_items::in, module_imported_items::out) is det.
|
|
|
|
set_module_imported_items(recomp_type_name, Set, !MII) :-
|
|
!MII ^ mii_type_names := Set.
|
|
set_module_imported_items(recomp_type_defn, Set, !MII) :-
|
|
!MII ^ mii_type_defns := Set.
|
|
set_module_imported_items(recomp_inst, Set, !MII) :-
|
|
!MII ^ mii_insts := Set.
|
|
set_module_imported_items(recomp_mode, Set, !MII) :-
|
|
!MII ^ mii_modes := Set.
|
|
set_module_imported_items(recomp_typeclass, Set, !MII) :-
|
|
!MII ^ mii_typeclasses := Set.
|
|
set_module_imported_items(recomp_functor, Set, !MII) :-
|
|
!MII ^ mii_functors := Set.
|
|
set_module_imported_items(recomp_predicate, Set, !MII) :-
|
|
!MII ^ mii_predicates := Set.
|
|
set_module_imported_items(recomp_function, Set, !MII) :-
|
|
!MII ^ mii_functions := Set.
|
|
set_module_imported_items(recomp_mutable, _Set, !MII) :-
|
|
unexpected($pred, "recomp_mutable").
|
|
set_module_imported_items(recomp_foreign_proc, _Set, !MII) :-
|
|
unexpected($pred, "recomp_foreign_proc").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module recompilation.usage.
|
|
%---------------------------------------------------------------------------%
|