[m-rev.] for review: unused imports analysis
Peter Ross
pro at missioncriticalit.com
Thu Sep 14 06:22:14 AEST 2006
Hi,
Note by default this option isn't enabled. This is because I don't
have the time to fix all the warnings in the compiler. I've been
testing this on a program we are developing here at MC.
===================================================================
Branch: main
Estimated hours: 24
Add an analysis which determines the set of modules which
are imported but are not used.
It also has a more precise analysis of those modules not needed
in the interface, as it reports more modules than the current
analysis.
compiler/unused_imports.m:
The module which does the analysis.
compiler/make_hlds_passes.m:
Record the parent used modules.
Factor out the code for adding the module specifiers.
compiler/hlds_module.m:
Add utility predicates for recording those modules
used in the parent modules of the current module and
those imports which are in the interface.
compiler/options.m:
Add the option --warn-unused-imports.
By default it's turned off because I have yet
to run this analysis on the compiler and fix
the modules.
compiler/check_hlds.m:
compiler/mercury_compile.m:
Add the analysis to the compiler.
doc/user_guide.texi:
Document the new option.
Index: compiler/check_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_hlds.m,v
retrieving revision 1.15
diff -U5 -r1.15 check_hlds.m
--- compiler/check_hlds.m 20 Jul 2006 01:50:42 -0000 1.15
+++ compiler/check_hlds.m 13 Sep 2006 20:13:38 -0000
@@ -81,10 +81,13 @@
:- include_module simplify.
% Warnings about insts with no matching types
:- include_module inst_check.
+% Warnings about unused imports
+:- include_module unused_imports.
+
:- include_module goal_path.
%-----------------------------------------------------------------------------%
:- implementation.
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.140
diff -U5 -r1.140 hlds_module.m
--- compiler/hlds_module.m 7 Sep 2006 05:50:53 -0000 1.140
+++ compiler/hlds_module.m 13 Sep 2006 20:13:38 -0000
@@ -303,12 +303,12 @@
maybe(recompilation_info)::out) is det.
:- pred module_info_set_maybe_recompilation_info(maybe(recompilation_info)::in,
module_info::in, module_info::out) is det.
-:- pred module_add_imported_module_specifiers(list(module_specifier)::in,
- module_info::in, module_info::out) is det.
+:- pred module_add_imported_module_specifiers(import_status::in,
+ list(module_specifier)::in, module_info::in, module_info::out) is det.
:- pred module_info_get_imported_module_specifiers(module_info::in,
set(module_specifier)::out) is det.
:- pred module_add_indirectly_imported_module_specifiers(
@@ -488,10 +488,19 @@
structure_reuse_map::out) is det.
:- pred module_info_set_structure_reuse_map(structure_reuse_map::in,
module_info::in, module_info::out) is det.
+:- pred module_info_get_parent_used_modules(module_info::in,
+ list(module_name)::out) is det.
+
+:- pred module_info_add_parent_used_modules(list(module_name)::in,
+ module_info::in, module_info::out) is det.
+
+:- pred module_info_get_interface_module_specifiers(module_info::in,
+ set(module_name)::out) is det.
+
%-----------------------------------------------------------------------------%
:- pred module_info_preds(module_info::in, pred_table::out) is det.
% Given a pred_id, return the pred_info of the specified pred.
@@ -743,11 +752,19 @@
% finalpred' directives in this module, in order of
% appearance.
user_final_pred_c_names :: assoc_list(sym_name, string),
% Information about which procedures implement structure reuse.
- structure_reuse_map :: structure_reuse_map
+ structure_reuse_map :: structure_reuse_map,
+
+ % The list of modules used in the parent modules of the current
+ % module
+ parent_used_modules :: list(module_name),
+
+ % All the directly imported module specifiers in the interface.
+ % (Used by unused_imports analysis).
+ interface_module_specifiers :: set(module_specifier)
).
module_info_init(Name, Items, Globals, QualifierInfo, RecompInfo,
ModuleInfo) :-
predicate_table_init(PredicateTable),
@@ -786,11 +803,11 @@
map.init(NoTagTypes),
ModuleSubInfo = module_sub_info(Name, Globals, no, [], [], [], [], no, 0,
[], [], StratPreds, UnusedArgInfo, ExceptionInfo, TrailingInfo,
MM_TablingInfo, map.init, counter.init(1), ImportedModules,
IndirectlyImportedModules, TypeSpecInfo, NoTagTypes, no, [],
- init_analysis_info(mmc), [], [], map.init),
+ init_analysis_info(mmc), [], [], map.init, [], set.init),
ModuleInfo = module_info(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
ExclusiveTable, FieldNameTable, RecompInfo).
@@ -875,10 +892,14 @@
MI ^ sub_info ^ maybe_complexity_proc_map).
module_info_get_complexity_proc_infos(MI,
MI ^ sub_info ^ complexity_proc_infos).
module_info_get_structure_reuse_map(MI,
MI ^ sub_info ^ structure_reuse_map).
+module_info_get_parent_used_modules(MI,
+ MI ^ sub_info ^ parent_used_modules).
+module_info_get_interface_module_specifiers(MI,
+ MI ^ sub_info ^ interface_module_specifiers).
% XXX There is some debate as to whether duplicate initialise directives
% in the same module should constitute an error. Currently it is not, but
% we may wish to revisit this code. The reference manual is therefore
% deliberately quiet on the subject.
@@ -968,14 +989,22 @@
MI ^ sub_info ^ mm_tabling_info := NewVal).
module_info_set_lambdas_per_context(NewVal, MI,
MI ^ sub_info ^ lambdas_per_context := NewVal).
module_info_set_model_non_pragma_counter(NewVal, MI,
MI ^ sub_info ^ model_non_pragma_counter := NewVal).
-module_add_imported_module_specifiers(ModuleSpecifiers, MI,
- MI ^ sub_info ^ imported_module_specifiers :=
- set.insert_list(MI ^ sub_info ^ imported_module_specifiers,
- ModuleSpecifiers)).
+module_add_imported_module_specifiers(IStat, ModuleSpecifiers, !MI) :-
+ !:MI = !.MI ^ sub_info ^ imported_module_specifiers :=
+ set.insert_list(!.MI ^ sub_info ^ imported_module_specifiers,
+ ModuleSpecifiers),
+ ( status_is_exported_to_non_submodules(IStat) = yes ->
+ !:MI = !.MI ^ sub_info ^ interface_module_specifiers :=
+ set.insert_list(!.MI ^ sub_info ^ interface_module_specifiers,
+ ModuleSpecifiers)
+ ;
+ true
+ ).
+
module_add_indirectly_imported_module_specifiers(Modules, MI,
MI ^ sub_info ^ indirectly_imported_module_specifiers :=
set.insert_list(MI ^ sub_info ^ indirectly_imported_module_specifiers,
Modules)).
module_info_set_type_spec_info(NewVal, MI,
@@ -988,10 +1017,16 @@
MI ^ sub_info ^ maybe_complexity_proc_map := NewVal).
module_info_set_complexity_proc_infos(NewVal, MI,
MI ^ sub_info ^ complexity_proc_infos := NewVal).
module_info_set_structure_reuse_map(ReuseMap, MI,
MI ^ sub_info ^ structure_reuse_map := ReuseMap).
+
+module_info_add_parent_used_modules(Modules, MI,
+ MI ^ sub_info ^ parent_used_modules := UsedModules) :-
+ module_info_get_parent_used_modules(MI, UsedModules0),
+ UsedModules = list.sort_and_remove_dups(Modules ++ UsedModules0).
+
%-----------------------------------------------------------------------------%
% Various predicates which do simple things that are nevertheless
% beyond the capability of an access predicate.
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.53
diff -U5 -r1.53 make_hlds_passes.m
--- compiler/make_hlds_passes.m 10 Sep 2006 23:39:01 -0000 1.53
+++ compiler/make_hlds_passes.m 13 Sep 2006 20:13:39 -0000
@@ -385,32 +385,14 @@
Item = item_module_defn(_VarSet, ModuleDefn),
( module_defn_update_import_status(ModuleDefn, StatusPrime) ->
!:Status = StatusPrime
; ModuleDefn = md_import(list_module(Specifiers)) ->
!.Status = item_status(IStat, _),
- (
- ( status_defined_in_this_module(IStat) = yes
- ; IStat = status_imported(import_locn_ancestor_private_interface)
- )
- ->
- module_add_imported_module_specifiers(Specifiers, !ModuleInfo)
- ;
- module_add_indirectly_imported_module_specifiers(Specifiers,
- !ModuleInfo)
- )
+ add_module_specifiers(Specifiers, IStat, !ModuleInfo)
; ModuleDefn = md_use(list_module(Specifiers)) ->
!.Status = item_status(IStat, _),
- (
- ( status_defined_in_this_module(IStat) = yes
- ; IStat = status_imported(import_locn_ancestor)
- )
- ->
- module_add_imported_module_specifiers(Specifiers, !ModuleInfo)
- ;
- module_add_indirectly_imported_module_specifiers(Specifiers,
- !ModuleInfo)
- )
+ add_module_specifiers(Specifiers, IStat, !ModuleInfo)
; ModuleDefn = md_include_module(_) ->
true
; ModuleDefn = md_external(MaybeBackend, External) ->
( External = name_arity(Name, Arity) ->
module_info_get_globals(!.ModuleInfo, Globals),
@@ -558,10 +540,26 @@
add_solver_type_mutable_items_pass_1([Item | Items], Context, !Status,
!ModuleInfo, !Specs) :-
add_item_decl_pass_1(Item, Context, !Status, !ModuleInfo, _, !Specs),
add_solver_type_mutable_items_pass_1(Items, Context, !Status, !ModuleInfo,
!Specs).
+
+:- pred add_module_specifiers(list(module_specifier)::in, import_status::in, module_info::in, module_info::out) is det.
+
+add_module_specifiers(Specifiers, IStat, !ModuleInfo) :-
+ ( status_defined_in_this_module(IStat) = yes ->
+ module_add_imported_module_specifiers(IStat, Specifiers, !ModuleInfo)
+ ; IStat = status_imported(import_locn_ancestor_private_interface) ->
+ module_add_imported_module_specifiers(IStat, Specifiers, !ModuleInfo),
+
+ % Any import_module which comes from a private interface
+ % must by definition be a module used by the parent module.
+ module_info_add_parent_used_modules(Specifiers, !ModuleInfo)
+ ;
+ module_add_indirectly_imported_module_specifiers(Specifiers,
+ !ModuleInfo)
+ ).
%-----------------------------------------------------------------------------%
:- pred add_item_decl_pass_2(item::in, prog_context::in, item_status::in,
item_status::out, module_info::in, module_info::out,
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.402
diff -U5 -r1.402 mercury_compile.m
--- compiler/mercury_compile.m 12 Sep 2006 04:41:39 -0000 1.402
+++ compiler/mercury_compile.m 13 Sep 2006 20:13:40 -0000
@@ -136,10 +136,11 @@
:- import_module ml_backend.ml_util. % MLDS utility predicates
% miscellaneous compiler modules
:- import_module check_hlds.goal_path.
:- import_module check_hlds.inst_check.
+:- import_module check_hlds.unused_imports.
:- import_module hlds.arg_info.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_pred.
@@ -2295,10 +2296,17 @@
globals.io_lookup_bool_option(verbose, Verbose, !IO),
globals.io_lookup_bool_option(statistics, Stats, !IO),
maybe_polymorphism(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 30, "polymorphism", !DumpInfo, !IO),
+
+ globals.io_lookup_bool_option(warn_unused_imports, WarnUnusedImports, !IO),
+ ( WarnUnusedImports = yes ->
+ unused_imports(!HLDS, !IO)
+ ;
+ true
+ ),
maybe_mode_constraints(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 33, "mode_constraints", !DumpInfo, !IO),
modecheck(Verbose, Stats, !HLDS, FoundModeError, UnsafeToContinue, !IO),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.526
diff -U5 -r1.526 options.m
--- compiler/options.m 10 Sep 2006 23:39:05 -0000 1.526
+++ compiler/options.m 13 Sep 2006 20:13:41 -0000
@@ -112,10 +112,11 @@
; warn_non_term_special_preds
; warn_known_bad_format_calls
; warn_unknown_format_calls
; warn_obsolete
; warn_insts_without_matching_type
+ ; warn_unused_imports
% Verbosity options
; verbose
; very_verbose
; verbose_errors
@@ -867,11 +868,16 @@
warn_table_with_inline - bool(yes),
warn_non_term_special_preds - bool(yes),
warn_known_bad_format_calls - bool(yes),
warn_unknown_format_calls - bool(no),
warn_obsolete - bool(yes),
- warn_insts_without_matching_type - bool(yes)
+ warn_insts_without_matching_type - bool(yes),
+ % XXX disabled by default until someone
+ % removes all the unused imports from
+ % the compiler itself which is compiled
+ % with --halt-at-warn by default.
+ warn_unused_imports - bool(no)
]).
option_defaults_2(verbosity_option, [
% Verbosity Options
verbose - bool(no),
very_verbose - bool(no),
@@ -1574,10 +1580,11 @@
long_option("warn-known-bad-format-calls", warn_known_bad_format_calls).
long_option("warn-unknown-format-calls", warn_unknown_format_calls).
long_option("warn-obsolete", warn_obsolete).
long_option("warn-insts-without-matching-type",
warn_insts_without_matching_type).
+long_option("warn-unused-imports", warn_unused_imports).
% verbosity options
long_option("verbose", verbose).
long_option("very-verbose", very_verbose).
long_option("verbose-error-messages", verbose_errors).
@@ -2787,10 +2794,16 @@
"\tDon't warn about procedures whose determinism is inferred",
"\terroneous but whose determinism declarations are laxer.",
"--no-warn-insts-without-matching-type",
"\tDon't warn about insts that are not consistent with any",
"\tof the types in scope.",
+ % XXX disabled until compiler unused_imports,
+ % don't forget to update the user_guide.texi
+ % "--no-warn-unused-imports",
+ % "\tDon't warn about modules which are imported but aren't used.",
+ "--warn-unused-imports",
+ "\tWarn about modules which are imported but aren't used.",
"--no-warn-nothing-exported",
"\tDon't warn about modules which export nothing.",
"--warn-unused-args",
"\tWarn about predicate arguments which are not used.",
"--warn-interface-imports",
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.489
diff -U5 -r1.489 user_guide.texi
--- doc/user_guide.texi 4 Sep 2006 01:47:34 -0000 1.489
+++ doc/user_guide.texi 13 Sep 2006 20:13:47 -0000
@@ -5274,10 +5274,18 @@
@findex --warn-insts-without-matching-type
Don't warn about insts that are not consistent with any
types in scope.
@sp 1
+ at c @item --no-warn-unused-imports
+ at item --warn-unused-imports
+ at findex --no-warn-unused-imports
+ at findex --warn-unused-imports
+Warn about modules which are imported but aren't used.
+ at c Don't warn about modules which are imported but aren't used.
+
+ at sp 1
@item --no-warn-nothing-exported
@findex --no-warn-nothing-exported
@findex --warn-nothing-exported
Don't warn about modules whose interface sections have no
exported predicates, functions, insts, modes or types.
New File: compiler/unused_imports.m
===================================================================
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: unused_imports.m.
% Main author: petdr.
%
% This module scans the current module determining all the modules which are
% used in the module and then compares that with the set of modules imported
% and reports those modules which are unused.
%
% It also determines which imports aren't used in the interface, and thus
% should only be in the implementation.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.unused_imports.
:- interface.
:- import_module io.
:- import_module hlds.hlds_module.
% This predicate issues a warning for each import_module
% which is not directly used in this module, plus those
% which are in the interface but should be in the implementation.
%
:- pred unused_imports(module_info::in,
module_info::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module hlds.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module relation.
:- import_module set.
:- import_module string.
:- import_module svset.
:- import_module term.
:- type status
---> public
; private.
:- type used_modules
---> used_modules(
% The modules used in the interface and implementation.
int_used_modules :: set(module_name),
impl_used_modules :: set(module_name),
% The types used in the interface and implementation.
int_used_types :: set(type_ctor),
impl_used_types :: set(type_ctor),
% :- type map(K, V) == tree234(K, V)
%
% will appear in the relation as tree234/2 -> map/2.
% Thus the transitive closure from the tree234/2
% will include all the possible equivalence types
% of tree234/2.
eqv_types :: relation(type_ctor)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
unused_imports(!ModuleInfo, !IO) :-
%
% Each parent module of the current module imports are inherited by
% this module so we have to add the used modules of the parents to
% the set of used modules, as an import in the parent may only be
% consumed by the parent.
%
% We also consider the implicitly imported modules to be used as
% the user cannot do anything about them.
%
ImplicitImports = [unqualified("builtin"),
unqualified("private_builtin"), unqualified("table_builtin")],
module_info_get_parent_used_modules(!.ModuleInfo, ParentImports),
UsedModules0 = used_modules(
set(ImplicitImports ++ ParentImports),
set.init, set.init, set.init, relation.init),
used_modules(!.ModuleInfo, UsedModules0, UsedModules),
%
% The unused imports is simply the set of imports minus all the
% used modules.
%
module_info_get_imported_module_specifiers(!.ModuleInfo, ImportedModules),
UsedInImplementation = UsedModules ^ impl_used_modules,
UnusedImports = to_sorted_list(
ImportedModules `difference`
(UsedInInterface `union` UsedInImplementation)),
( UnusedImports = [_|_] ->
output_warning(!.ModuleInfo, UnusedImports, "", !IO)
;
true
),
%
% Determine the modules imported in the interface but not used in
% the interface.
%
module_info_get_interface_module_specifiers(!.ModuleInfo,
InterfaceImports),
UsedInInterface = UsedModules ^ int_used_modules,
UnusedInterfaceImports = to_sorted_list(InterfaceImports
`difference` UsedInInterface `difference` set(UnusedImports)),
( UnusedInterfaceImports = [_|_] ->
output_warning(!.ModuleInfo, UnusedInterfaceImports, " interface", !IO)
;
true
).
:- pred output_warning(module_info::in,
list(module_name)::in, string::in, io::di, io::uo) is det.
output_warning(ModuleInfo, UnusedImports, Location, !IO) :-
module_info_get_name(ModuleInfo, ModuleName),
module_name_to_file_name(ModuleName, ".m", no, FileName, !IO),
term.context_init(FileName, 1, Context),
( UnusedImports = [_] ->
ModuleWord = "module"
;
ModuleWord = "modules"
),
is_or_are(UnusedImports, IsOrAre),
( Location = "" ->
InThe = "",
LocationOf = ""
;
InThe = " in the",
LocationOf = Location ++ " of"
),
UnusedSymNames = list.map(wrap_module_name, UnusedImports),
Pieces = [words("In " ++ LocationOf ++ " module" ), sym_name(ModuleName),
suffix(":"), nl,
words("warning:"), words(ModuleWord)] ++
component_list_to_pieces(UnusedSymNames) ++
[fixed(IsOrAre), words("imported, "),
words("but"), fixed(IsOrAre),
words("not used" ++ InThe ++ Location ++ ".")],
write_error_pieces(Context, 0, Pieces, !IO),
record_warning(!IO).
%-----------------------------------------------------------------------------%
:- func wrap_module_name(module_name) = format_component.
wrap_module_name(SymName) = sym_name(SymName).
:- pred is_or_are(list(T)::in, string::out) is det.
is_or_are([], "") :-
unexpected("unused_imports.m", "unused_imports.is_or_are").
is_or_are([_], "is").
is_or_are([_, _ | _], "are").
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Scan each item in the module info recording the module qualifications on
% the item and if that module is used in the interface or implementation
% section of the module.
%
:- pred used_modules(module_info::in,
used_modules::in, used_modules::out) is det.
used_modules(ModuleInfo, !UsedModules) :-
module_info_get_type_table(ModuleInfo, TypeTable),
map.foldl(type_used_modules, TypeTable, !UsedModules),
module_info_get_inst_table(ModuleInfo, InstTable),
inst_table_get_user_insts(InstTable, UserInstTable),
user_inst_table_get_inst_defns(UserInstTable, UserInsts),
map.foldl(user_inst_used_modules, UserInsts, !UsedModules),
module_info_get_mode_table(ModuleInfo, ModeTable),
mode_table_get_mode_defns(ModeTable, ModeDefns),
map.foldl(mode_used_modules, ModeDefns, !UsedModules),
module_info_get_class_table(ModuleInfo, ClassTable),
map.foldl(class_used_modules, ClassTable, !UsedModules),
module_info_get_instance_table(ModuleInfo, InstanceTable),
map.foldl(instance_used_modules, InstanceTable, !UsedModules),
module_info_preds(ModuleInfo, PredTable),
map.foldl(pred_info_used_modules, PredTable, !UsedModules),
%
% Handle the fact that equivalence types have been pre-expanded.
%
set.fold(add_eqv_type_used_modules(public),
!.UsedModules ^ int_used_types, !UsedModules),
set.fold(add_eqv_type_used_modules(private),
!.UsedModules ^ impl_used_types, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% As equivalence types are expanded we have to take each type used by
% the system and determine with which other types this type may be
% equivalent to, and add the modules where these types come from as
% being used as the type may have been actually imported using this
% name.
%
% XXX I think a better way would be to modify equiv_types.m to record
% for the interface and implementation section exactly which type_ctor's
% were expanded. I looked into this but didn't have enough time to do it.
%
:- pred add_eqv_type_used_modules(status::in,
type_ctor::in, used_modules::in, used_modules::out) is det.
add_eqv_type_used_modules(Status, TypeCtor, !UsedModules) :-
Relation = !.UsedModules ^ eqv_types,
( relation.search_element(Relation, TypeCtor, Key) ->
EqvTypeKeys = relation.dfs(Relation, Key),
EqvTypes = list.map(relation.lookup_key(Relation), EqvTypeKeys),
list.foldl(type_ctor_used_modules(Status), EqvTypes, !UsedModules)
;
true
).
:- pred type_ctor_used_modules(status::in,
type_ctor::in, used_modules::in, used_modules::out) is det.
type_ctor_used_modules(Status, type_ctor(Name, _), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred type_used_modules(type_ctor::in, hlds_type_defn::in,
used_modules::in, used_modules::out) is det.
type_used_modules(TypeCtor, TypeDefn, !UsedModules) :-
get_type_defn_status(TypeDefn, ImportStatus),
get_type_defn_body(TypeDefn, TypeBody),
( status_defined_in_this_module(ImportStatus) = yes ->
Status = status(ImportStatus),
( TypeBody = hlds_du_type(Ctors, _, _, _, _, _),
list.foldl(ctor_used_modules(Status), Ctors, !UsedModules)
; TypeBody = hlds_eqv_type(EqvType),
mer_type_used_modules(Status, EqvType, !UsedModules)
; TypeBody = hlds_foreign_type(_),
true
; TypeBody = hlds_solver_type(_, _),
true
; TypeBody = hlds_abstract_type(_),
true
)
;
true
),
% Determine which equivalence types are related to each
% other.
( TypeBody = hlds_eqv_type(EType) ->
( type_to_ctor_and_args(EType, EqvTypeCtor, _) ->
relation.add_values(!.UsedModules ^ eqv_types,
EqvTypeCtor, TypeCtor, EqvTypes),
!:UsedModules = !.UsedModules ^ eqv_types := EqvTypes
;
true
)
;
true
).
:- pred ctor_used_modules(status::in,
constructor::in, used_modules::in, used_modules::out) is det.
ctor_used_modules(Status, ctor(_, Constraints, _, Args), !UsedModules) :-
list.foldl(prog_constraint_used_module(Status), Constraints, !UsedModules),
list.foldl(
(pred(_ - Arg::in, !.M::in, !:M::out) is det :-
mer_type_used_modules(Status, Arg, !M)
), Args, !UsedModules).
:- pred prog_constraint_used_module(status::in, prog_constraint::in,
used_modules::in, used_modules::out) is det.
prog_constraint_used_module(Status,
constraint(ClassName, Args), !UsedModules) :-
add_sym_name_module(Status, ClassName, !UsedModules),
list.foldl(mer_type_used_modules(Status), Args, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred user_inst_used_modules(inst_id::in,
hlds_inst_defn::in, used_modules::in, used_modules::out) is det.
user_inst_used_modules(_InstId, InstDefn, !UsedModules) :-
ImportStatus = InstDefn ^ inst_status,
( status_defined_in_this_module(ImportStatus) = yes ->
Status = status(ImportStatus),
InstBody = InstDefn ^ inst_body,
( InstBody = eqv_inst(Inst),
mer_inst_used_modules(Status, Inst, !UsedModules)
; InstBody = abstract_inst,
true
)
;
true
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred mode_used_modules(mode_id::in,
hlds_mode_defn::in, used_modules::in, used_modules::out) is det.
mode_used_modules(mode_id(Name, _Arity), ModeDefn, !UsedModules) :-
ImportStatus = ModeDefn ^ mode_status,
( status_defined_in_this_module(ImportStatus) = yes ->
Status = status(ImportStatus),
add_sym_name_module(Status, Name, !UsedModules),
ModeBody = ModeDefn ^ mody_body,
ModeBody = eqv_mode(Mode),
mer_mode_used_modules(Status, Mode, !UsedModules)
;
true
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred class_used_modules(class_id::in,
hlds_class_defn::in, used_modules::in, used_modules::out) is det.
class_used_modules(class_id(Name, _Arity), ClassDefn, !UsedModules) :-
ImportStatus = ClassDefn ^ class_status,
( status_defined_in_this_module(ImportStatus) = yes ->
Status = status(ImportStatus),
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(prog_constraint_used_module(Status),
ClassDefn ^ class_supers, !UsedModules)
;
true
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred instance_used_modules(class_id::in, list(hlds_instance_defn)::in,
used_modules::in, used_modules::out) is det.
instance_used_modules(ClassId, InstanceDefns, !UsedModules) :-
list.foldl(instance_used_modules_2(ClassId), InstanceDefns, !UsedModules).
:- pred instance_used_modules_2(class_id::in, hlds_instance_defn::in,
used_modules::in, used_modules::out) is det.
instance_used_modules_2(class_id(Name, _Arity), InstanceDefn, !UsedModules) :-
ImportStatus = InstanceDefn ^ instance_status,
( status_defined_in_this_module(ImportStatus) = yes ->
% The methods of the class are stored in the pred_table and hence
% will be processed by pred_info_used_modules.
% XXX is this true?
Status = status(ImportStatus),
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(prog_constraint_used_module(Status),
InstanceDefn ^ instance_constraints, !UsedModules),
list.foldl(mer_type_used_modules(Status),
InstanceDefn ^ instance_types, !UsedModules)
;
true
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred pred_info_used_modules(pred_id::in,
pred_info::in, used_modules::in, used_modules::out) is det.
pred_info_used_modules(_PredId, PredInfo, !UsedModules) :-
pred_info_get_import_status(PredInfo, ImportStatus),
( status_defined_in_this_module(ImportStatus) = yes ->
Status = status(ImportStatus),
pred_info_get_arg_types(PredInfo, Args),
list.foldl(mer_type_used_modules(Status), Args, !UsedModules),
pred_info_get_class_context(PredInfo, Constraints),
Constraints = constraints(UnivConstraints, ExistConstraints),
list.foldl(prog_constraint_used_module(Status),
UnivConstraints, !UsedModules),
list.foldl(prog_constraint_used_module(Status),
ExistConstraints, !UsedModules),
pred_info_get_procedures(PredInfo, ProcTable),
map.foldl(proc_info_used_modules(Status), ProcTable, !UsedModules),
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_used_modules(ClausesInfo, !UsedModules)
;
true
).
:- pred proc_info_used_modules(status::in, proc_id::in, proc_info::in,
used_modules::in, used_modules::out) is det.
proc_info_used_modules(Status, _ProcId, ProcInfo, !UsedModules) :-
proc_info_get_maybe_declared_argmodes(ProcInfo, MaybeArgModes),
( MaybeArgModes = yes(Modes),
list.foldl(mer_mode_used_modules(Status), Modes, !UsedModules)
; MaybeArgModes = no,
true
).
:- pred clauses_info_used_modules(clauses_info::in,
used_modules::in, used_modules::out) is det.
clauses_info_used_modules(ClausesInfo, !UsedModules) :-
clauses_info_get_clauses_rep(ClausesInfo, ClausesRep),
get_clause_list(ClausesRep, Clauses),
list.foldl(clause_used_modules, Clauses, !UsedModules).
:- pred clause_used_modules(clause::in,
used_modules::in, used_modules::out) is det.
clause_used_modules(clause(_, Goal, _, _), !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred hlds_goal_used_modules(hlds_goal::in, used_modules::in, used_modules::out) is det.
hlds_goal_used_modules(unify(_, Rhs, _, _, _) - _, !UsedModules) :-
unify_rhs_used_modules(Rhs, !UsedModules).
hlds_goal_used_modules(plain_call(_, _, _, _, _, Name) - _, !UsedModules) :-
add_sym_name_module(private, Name, !UsedModules).
hlds_goal_used_modules(generic_call(Call, _, _, _) - _, !UsedModules) :-
( Call = higher_order(_, _, _, _),
true
; Call = class_method(_, _, ClassId, CallId),
ClassId = class_id(ClassName, _),
add_sym_name_module(private, ClassName, !UsedModules),
CallId = simple_call_id(_, MethodName, _),
add_sym_name_module(private, MethodName, !UsedModules)
; Call = event_call(_),
true
; Call = cast(_),
true
).
hlds_goal_used_modules(
call_foreign_proc(_, _, _, _, _, _, _) - _, !UsedModules) :-
% XXX is there a sym_name here?
true.
hlds_goal_used_modules(conj(_, Goals) - _, !UsedModules) :-
list.foldl(hlds_goal_used_modules, Goals, !UsedModules).
hlds_goal_used_modules(disj(Goals) - _, !UsedModules) :-
list.foldl(hlds_goal_used_modules, Goals, !UsedModules).
hlds_goal_used_modules(switch(_, _, Cases) - _, !UsedModules) :-
list.foldl(
(pred(case(ConsId, Goal)::in, !.M::in, !:M::out) is det :-
cons_id_used_modules(private, ConsId, !M),
hlds_goal_used_modules(Goal, !M)
), Cases, !UsedModules).
hlds_goal_used_modules(negation(Goal) - _, !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
hlds_goal_used_modules(scope(_, Goal) - _, !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
hlds_goal_used_modules(if_then_else(_, If, Then, Else) - _, !UsedModules) :-
hlds_goal_used_modules(If, !UsedModules),
hlds_goal_used_modules(Then, !UsedModules),
hlds_goal_used_modules(Else, !UsedModules).
hlds_goal_used_modules(
shorthand(bi_implication(GoalA, GoalB)) - _, !UsedModules) :-
hlds_goal_used_modules(GoalA, !UsedModules),
hlds_goal_used_modules(GoalB, !UsedModules).
:- pred unify_rhs_used_modules(unify_rhs::in,
used_modules::in, used_modules::out) is det.
unify_rhs_used_modules(rhs_var(_), !UsedModules).
unify_rhs_used_modules(rhs_functor(ConsId, _, _), !UsedModules) :-
cons_id_used_modules(private, ConsId, !UsedModules).
unify_rhs_used_modules(
rhs_lambda_goal(_, _, _, _, _, _, _, Goal), !UsedModules) :-
hlds_goal_used_modules(Goal, !UsedModules).
:- pred cons_id_used_modules(status::in,
cons_id::in, used_modules::in, used_modules::out) is det.
cons_id_used_modules(Status, cons(Name, _), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules).
cons_id_used_modules(_, int_const(_), !UsedModules).
cons_id_used_modules(_, string_const(_), !UsedModules).
cons_id_used_modules(_, float_const(_), !UsedModules).
cons_id_used_modules(_, pred_const(_, _), !UsedModules).
cons_id_used_modules(Status,
type_ctor_info_const(ModuleName, _, _), !UsedModules) :-
add_all_modules(Status, ModuleName, !UsedModules).
cons_id_used_modules(Status,
base_typeclass_info_const(ModuleName, _, _, _), !UsedModules) :-
add_all_modules(Status, ModuleName, !UsedModules).
cons_id_used_modules(Status,
type_info_cell_constructor(type_ctor(SymName, _Arity)),
!UsedModules) :-
add_sym_name_module(Status, SymName, !UsedModules).
cons_id_used_modules(_, typeclass_info_cell_constructor, !UsedModules).
cons_id_used_modules(_, tabling_info_const(_), !UsedModules).
cons_id_used_modules(_, deep_profiling_proc_layout(_), !UsedModules).
cons_id_used_modules(_, table_io_decl(_), !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred mer_type_used_modules(status::in,
mer_type::in, used_modules::in, used_modules::out) is det.
mer_type_used_modules(Status, Type, !UsedModules) :-
mer_type_used_modules_2(Status, Type, !UsedModules),
( type_to_ctor_and_args(Type, TypeCtor, Args) ->
add_type_ctor(Status, TypeCtor, !UsedModules),
list.foldl(mer_type_used_modules(Status), Args, !UsedModules)
;
true
).
:- pred mer_type_used_modules_2(status::in,
mer_type::in, used_modules::in, used_modules::out) is det.
mer_type_used_modules_2(_Status, type_variable(_, _), !UsedModules).
mer_type_used_modules_2(Status, defined_type(Name, Args, _), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(mer_type_used_modules(Status), Args, !UsedModules).
mer_type_used_modules_2(_Status, builtin_type(_), !UsedModules).
mer_type_used_modules_2(Status,
higher_order_type(Args, MaybeReturn, _, _), !UsedModules) :-
list.foldl(mer_type_used_modules(Status), Args, !UsedModules),
( MaybeReturn = yes(Return),
mer_type_used_modules(Status, Return, !UsedModules)
; MaybeReturn = no,
true
).
mer_type_used_modules_2(Status, tuple_type(Args, _), !UsedModules) :-
list.foldl(mer_type_used_modules(Status), Args, !UsedModules).
mer_type_used_modules_2(Status, apply_n_type(_, Args, _), !UsedModules) :-
list.foldl(mer_type_used_modules(Status), Args, !UsedModules).
mer_type_used_modules_2(Status, kinded_type(Arg, _), !UsedModules) :-
mer_type_used_modules(Status, Arg, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred mer_mode_used_modules(status::in,
mer_mode::in, used_modules::in, used_modules::out) is det.
mer_mode_used_modules(Status, Inst0 -> Inst, !UsedModules) :-
mer_inst_used_modules(Status, Inst0, !UsedModules),
mer_inst_used_modules(Status, Inst, !UsedModules).
mer_mode_used_modules(Status, user_defined_mode(Name, Insts), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(mer_inst_used_modules(Status), Insts, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred mer_inst_used_modules(status::in,
mer_inst::in, used_modules::in, used_modules::out) is det.
mer_inst_used_modules(_, any(_), !UsedModules).
mer_inst_used_modules(_, free, !UsedModules).
mer_inst_used_modules(Status, free(Type), !UsedModules) :-
mer_type_used_modules(Status, Type, !UsedModules).
mer_inst_used_modules(Status, bound(_, BoundInsts), !UsedModules) :-
list.foldl(bound_inst_info_used_modules(Status), BoundInsts, !UsedModules).
mer_inst_used_modules(Status, ground(_, GroundInstInfo), !UsedModules) :-
ground_inst_info_used_modules(Status, GroundInstInfo, !UsedModules).
mer_inst_used_modules(_, not_reached, !UsedModules).
mer_inst_used_modules(_, inst_var(_), !UsedModules).
mer_inst_used_modules(Status,
constrained_inst_vars(_InstVars, Inst), !UsedModules) :-
mer_inst_used_modules(Status, Inst, !UsedModules).
mer_inst_used_modules(Status, defined_inst(InstName), !UsedModules) :-
inst_name_used_modules(Status, InstName, !UsedModules).
mer_inst_used_modules(Status, abstract_inst(Name, Insts), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(mer_inst_used_modules(Status), Insts, !UsedModules).
%-----------------------------------------------------------------------------%
:- pred bound_inst_info_used_modules(status::in,
bound_inst::in, used_modules::in, used_modules::out) is det.
bound_inst_info_used_modules(Status,
bound_functor(ConsId, Insts), !UsedModules) :-
cons_id_used_modules(Status, ConsId, !UsedModules),
list.foldl(mer_inst_used_modules(Status), Insts, !UsedModules).
:- pred ground_inst_info_used_modules(status::in, ground_inst_info::in,
used_modules::in, used_modules::out) is det.
ground_inst_info_used_modules(Status,
higher_order(pred_inst_info(_, Modes, _)), !UsedModules) :-
list.foldl(mer_mode_used_modules(Status), Modes, !UsedModules).
ground_inst_info_used_modules(_, none, !UsedModules).
%-----------------------------------------------------------------------------%
:- pred inst_name_used_modules(status::in,
inst_name::in, used_modules::in, used_modules::out) is det.
inst_name_used_modules(Status, user_inst(Name, Insts), !UsedModules) :-
add_sym_name_module(Status, Name, !UsedModules),
list.foldl(mer_inst_used_modules(Status), Insts, !UsedModules).
inst_name_used_modules(Status, merge_inst(Inst0, Inst), !UsedModules) :-
mer_inst_used_modules(Status, Inst0, !UsedModules),
mer_inst_used_modules(Status, Inst, !UsedModules).
inst_name_used_modules(Status, unify_inst(_, Inst0, Inst, _), !UsedModules) :-
mer_inst_used_modules(Status, Inst0, !UsedModules),
mer_inst_used_modules(Status, Inst, !UsedModules).
inst_name_used_modules(Status, ground_inst(InstName, _, _, _), !UsedModules) :-
inst_name_used_modules(Status, InstName, !UsedModules).
inst_name_used_modules(Status, any_inst(InstName, _, _, _), !UsedModules) :-
inst_name_used_modules(Status, InstName, !UsedModules).
inst_name_used_modules(Status, shared_inst(InstName), !UsedModules) :-
inst_name_used_modules(Status, InstName, !UsedModules).
inst_name_used_modules(Status, mostly_uniq_inst(InstName), !UsedModules) :-
inst_name_used_modules(Status, InstName, !UsedModules).
inst_name_used_modules(Status, typed_ground(_, Type), !UsedModules) :-
mer_type_used_modules(Status, Type, !UsedModules).
inst_name_used_modules(Status, typed_inst(Type, InstName), !UsedModules) :-
mer_type_used_modules(Status, Type, !UsedModules),
inst_name_used_modules(Status, InstName, !UsedModules).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Determine if the given import_status implies item is public (in the
% interface or private (in the implementation).
%
:- func status(import_status) = status.
status(ImportStatus) =
( status_is_exported_to_non_submodules(ImportStatus) = yes ->
public
;
private
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Given a sym_name add all the module qualifiers to the used_modules.
%
:- pred add_sym_name_module(status::in,
sym_name::in, used_modules::in, used_modules::out) is det.
add_sym_name_module(_Status, unqualified(_), !UsedModules).
add_sym_name_module(Status, qualified(ModuleName, _), !UsedModules) :-
add_all_modules(Status, ModuleName, !UsedModules).
%
% Given a module name add the module and all of its parent modules
% to the used_modules.
%
:- pred add_all_modules(status::in,
sym_name::in, used_modules::in, used_modules::out) is det.
add_all_modules(Status, ModuleName @ unqualified(_), !UsedModules) :-
add_module(Status, ModuleName, !UsedModules).
add_all_modules(Status, ModuleName @ qualified(Parent, _), !UsedModules) :-
add_module(Status, ModuleName, !UsedModules),
add_all_modules(Status, Parent, !UsedModules).
:- pred add_module(status::in,
module_name::in, used_modules::in, used_modules::out) is det.
add_module(public, Module, !UsedModules) :-
!:UsedModules = !.UsedModules ^ int_used_modules :=
set.insert(!.UsedModules ^ int_used_modules, Module).
add_module(private, Module, !UsedModules) :-
!:UsedModules = !.UsedModules ^ impl_used_modules :=
set.insert(!.UsedModules ^ impl_used_modules, Module).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Add the type_ctor to the used_modules.
%
:- pred add_type_ctor(status::in,
type_ctor::in, used_modules::in, used_modules::out) is det.
add_type_ctor(public, TypeCtor, !UsedModules) :-
!:UsedModules = !.UsedModules ^ int_used_types :=
set.insert(!.UsedModules ^ int_used_types, TypeCtor).
add_type_ctor(private, TypeCtor, !UsedModules) :-
!:UsedModules = !.UsedModules ^ impl_used_types :=
set.insert(!.UsedModules ^ impl_used_types, TypeCtor).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
--
Software Engineer (Work) +32 2 757 10 15
Mission Critical (Mobile) +32 485 482 559
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list