mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
7dccb03be114fbbc0b6c514b7f7fc94696e42487
mercury/compiler/recompilation.usage.m
Zoltan Somogyi ee9c7d3a84 Speed up bound vs ground inst checks. 
The code that checks whether a bound inst wrapped around
a list of bound_functors matched the ground inst did several things
in a suboptimal fashion.

- It looked up the definition of the type constructor of the relevant type
  (the type of the variable the inst is for) more than once. (This was
  not easily visible because the lookups were in different predicates.)
  This diff factors these out, not for the immesurably small speedup,
  but to make possible the fixes for the next two issues.

- To simplify the "is there a bound_functor for each constructor in the type"
  check, it sorted the constructors of the type by name and arity. (Lists of
  bound_functors are always sorted by name and arity.) Given that most
  modules contain more than one bound inst for any given type constructor,
  any sorting after the first was unnecessarily repeated work. This diff
  therefore extends the representation of du types, which until now has
  include only a list of the data constructors in the type definition
  in definition order, with a list of those exact same data constructors
  in name/arity order.

- Even if a list of bound_functors lists all the constructors of a type,
  the bound inst containing them is not equivalent to ground if the inst
  of some argument of some bound_inst is not equivalent to ground.
  This means that we need to know the actual argument of each constructor.
  The du type definition lists argument types that refer to the type
  constructor's type parameters; we need the instances of these argument types
  that apply to type of the variable at hand, which usually binds concrete
  types to those type parameters.

  We used to apply the type-parameter-to-actual-type substitution to
  each argument of each data constructor in the type before we compared
  the resulting filled-in data constructor descriptions against the list of
  bound_functors. However, in cases where the comparison fails, the
  substitution applications to arguments beyond the point of failure
  are all wasted work. This diff therefore applies the substitution
  only when its result is about to be needed.

This diff leads to a speedup of about 3.5% on tools/speedtest,
and about 38% (yes, more than a third) when compiling options.m.

compiler/hlds_data.m:
    Add the new field to the representation of du types.

    Add a utility predicate that helps construct that field, since it is
    now needed by two modules (add_type.m and equiv_type_hlds.m).

    Delete two functions that were used only by det_check_switch.m,
    which this diff moves to that module (in modified form).

compiler/inst_match.m:
    Implement the first and third changes listed above, and take advantage
    of the second.

    The old call to all_du_ctor_arg_types, which this diff replaces,
    effectively lied about the list of constructors it returned,
    by simply not returning any constructors containing existentially
    quantified  types, on the grounds that they "were not handled yet".
    We now fail explicitly when we find any such constructors.

    Perform the check for one-to-one match between bound_functors and
    constructors with less argument passing.

compiler/det_check_switch.m:
    Move the code deleted from hlds_data.m here, and simplify it,
    taking advantage of the new field in du types.

compiler/Mercury.options:
    Specify --optimize-constructor-last-call for det_check_switch.m
    to optimize the updated moved code.

compiler/add_foreign_enum.m:
compiler/add_special_pred.m:
compiler/add_type.m:
compiler/check_typeclass.m:
compiler/code_info.m:
compiler/dead_proc_elim.m:
compiler/direct_arg_in_out.m:
compiler/du_type_layout.m:
compiler/equiv_type_hlds.m:
compiler/hlds_out_type_table.m:
compiler/inst_check.m:
compiler/intermod.m:
compiler/intermod_decide.m:
compiler/lookup_switch_util.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen_test.m:
compiler/ml_unify_gen_util.m:
compiler/mlds.m:
compiler/post_term_analysis.m:
compiler/recompilation.usage.m:
compiler/resolve_unify_functor.m:
compiler/simplify_goal_ite.m:
compiler/table_gen.m:
compiler/tag_switch_util.m:
compiler/term_norm.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
compiler/typecheck_coerce.m:
compiler/unify_proc.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
    Conform to the changes above. This mostly means handling
    the new field in du types (usually by ignoring it).
2025-11-19 22:09:04 +11:00

1219 lines
48 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2001-2012 The University of Melbourne.
% Copyright (C) 2014-2025 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.record_uses.
:- 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_markers.
:- 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_data_pragma.
:- 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 recompilation.item_types.
:- 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) :-
(
MaybeTopModule = top_module(SubModuleSet),
SubModules = set.to_sorted_list(SubModuleSet),
MaybeTopModuleUsedFile = top_module_used_file(SubModules)
;
MaybeTopModule = not_top_module,
MaybeTopModuleUsedFile = not_top_module_used_file
),
% 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, MaybeTopModuleUsedFile,
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 data constructor?
module_info_get_cons_table(ModuleInfo, Ctors),
DuCtor = du_ctor(SymName, Arity, cons_id_dummy_type_ctor),
( if search_cons_table(Ctors, DuCtor, ConsDefns0) then
ConsDefns1 = ConsDefns0
else
ConsDefns1 = []
),
( if
remove_new_prefix(SymName, SymNameMinusNew),
DuCtorMinusNew = du_ctor(SymNameMinusNew, Arity,
cons_id_dummy_type_ctor),
search_cons_table(Ctors, DuCtorMinusNew, 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, _AccessType, _FieldName, OoMFieldDefns)
then
FieldDefns = one_or_more_to_list(OoMFieldDefns),
MatchingFieldAccessRFs = list.map(
( func(FieldDefn) = FieldAccessRF :-
FieldDefn =
hlds_ctor_field_defn(_, _, TypeCtor, FieldDuCtor, _),
FieldDuCtor = du_ctor(ConsName, ConsArity, _),
ConsCtor = cons_ctor(ConsName, ConsArity, TypeCtor),
FieldAccessRF = resolved_functor_field_access_func(ConsCtor)
), 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(_, _, ArgTypesAndMaybeModes,
_, _, _, _, _, _, _, Constraints, _),
find_items_used_by_class_context(Constraints, !Info),
(
ArgTypesAndMaybeModes = no_types_arity_zero
;
ArgTypesAndMaybeModes = types_only(ArgTypes),
list.foldl(find_items_used_by_type, ArgTypes, !Info)
;
ArgTypesAndMaybeModes = types_and_modes(ArgTypesAndModes),
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_and_mode(Type, Mode),
find_items_used_by_type(Type, !Info),
find_items_used_by_mode(Mode, !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),
marker_is_present(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 = univ_exist_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_tables(ModuleInfo, TypeSpecTables),
TypeSpecTables = type_spec_tables(_, _, _, PragmaMap),
( if map.search(PragmaMap, PredId, OoMTypeSpecPragmas) then
TypeSpecPragmas = one_or_more_to_list(OoMTypeSpecPragmas),
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)
),
SubstTypes = list.map((func(tvar_subst(_Var, Type)) = Type),
one_or_more_to_list(Subst)),
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(_, _, BoundFunctors),
list.foldl(find_items_used_by_bound_functor, BoundFunctors, !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_functor(bound_functor::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
find_items_used_by_bound_functor(BoundFunctor, !Info) :-
BoundFunctor = bound_functor(ConsId, ArgInsts),
( if ConsId = du_data_ctor(du_ctor(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(univ_exist_constraints::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
find_items_used_by_class_context(Constraints, !Info) :-
Constraints = univ_exist_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.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink