[m-rev.] for review: unused imports analysis
Julien Fischer
juliensf at csse.unimelb.edu.au
Thu Sep 14 17:30:21 AEST 2006
On Wed, 13 Sep 2006, Peter Ross wrote:
> 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.
>
> ===================================================================
Hi Pete,
I guess the main comment I have about this is that it should conform
to the new way of handling errors and warnings in the compiler, see:
<http://www.mercury.csse.unimelb.edu.au/mailing-lists/mercury-reviews/mercury-reviews.200609/0011.html>
and
<http://www.mercury.csse.unimelb.edu.au/mailing-lists/mercury-reviews/mercury-reviews.200609/0034.html>
> 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.
>
You also need to update the compiler design documentation in
compiler/notes/compiler_design.html.
...
> 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).
> 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.
That line exceeds 79 characters.
...
> 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
> + ),
Make this into a separate pass like the others, e.g. pass 31 or 32, e.g.
maybe_unused_imports(Verbose, Stats, !.HLDS, !IO),
maybe_dump_hlds(!.HLDS, 31, "unused_imports", !Dumpinfo, !IO),
>
> maybe_mode_constraints(Verbose, Stats, !HLDS, !IO),
> maybe_dump_hlds(!.HLDS, 33, "mode_constraints", !DumpInfo, !IO),
>
> modecheck(Verbose, Stats, !HLDS, FoundModeError, UnsafeToContinue, !IO),
...
> 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.
s/which/that/ and s/aren't/not/
(and also to the copy in options.m)
...
> 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.
That line should only be indented by one level (and throughout most of
the rest of this module). (Also, personally I prefer it if arguments
that are used as state variable pairs occur on the same line, e.g.
:- pred unused_imports(module_info::in, module_info::out,
io::di, io::uo) is det.
...
> :- type status
> ---> public
> ; private.
>
I suggest renaming that as follows:
:- type item_visibility
---> visibility_public
; visibility_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")],
Why does this list not include par_builtin, profiling_builtin and
term_size_profiling_builtin? In any case you should use the functions
defined in mdbcomp/prim_data.m to refer to these modules, e.g.
ImplicitImports = [mercury_public_builtin_module,
mercury_private_builtin_module,
mercury_table_builtin_module, ... etc
> 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
> ),
That can be a switch.
>
>
> %
> % 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
> ).
As can that.
>
> :- 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"
> ),
That could be a switch but error_util already defines an appropriate
predicate, choose_number/3, for exactly the this situation.
e.g.
ModuleWord = choose_number(UnusedImports, "module", "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").
>
That should probably go in error_util rather than here.
...
> % Scan each item in the module info recording the module qualifications on
s/module info/module_info/
> % 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.
> %
s/pre-expanded/expanded by now/
> 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
That's ambiguous: it could mean either that we do this while equivlence
types are being expanded or that we do this because equivalence types
have already been expanded.
> % 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
Since we now allow switch arms to share code those last arms should
be rewritten as:
(
...
;
( TypeBody = hlds_foreign_type(_)
; TypeBody = hlds_solver_type(_, )
; TypeBody = hlds_abstract_type(_)
),
true
)
...
> % Determine which equivalence types are related to each
> % other.
related is a bit vague.
> ( 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 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
> ).
Again, you can use the new support for switches with shared code here.
> hlds_goal_used_modules(
> call_foreign_proc(_, _, _, _, _, _, _) - _, !UsedModules) :-
> % XXX is there a sym_name here?
Do you mean for the name of the foreign procedure being called?
It's referred to by pred_proc_id only here.
Julien.
--------------------------------------------------------------------------
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