%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2009-2012 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: hlds_out_module.m.
% Main authors: conway, fjh.
%
%---------------------------------------------------------------------------%

:- module hlds.hlds_out.hlds_out_module.
:- interface.

:- import_module hlds.hlds_module.

:- import_module io.

%---------------------------------------------------------------------------%

    % Print out an entire HLDS structure.
    %
:- pred write_hlds(io.text_output_stream::in, module_info::in,
    io::di, io::uo) is det.

%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- implementation.

% XXX :- import_module hlds.pred_table.
% We actually use a type equivalence from pred_table.m (specifically,
% the fact that pred_id_table is a map), but we get an unused import warning
% for the above line anyway.
%
% The problem is as follows.
%
% - The write_preds predicate calls module_info_get_pred_id_table,
%   whose output has type pred_id_table. Therefore logically, the type
%   of the variable that holds this output is also pred_id_table,
%   which means that logically, this module *does* use *something*
%   exported by pred_table.m.
%
% - On the other hand, the equiv_type.m pass, which operates on the augmented
%   compilation unit, expands out equivalence types. The type of the output
%   argument of module_info_get_pred_id_table, pred_id_table, is thus
%   replaced with map(pred_id, pred_info). None of those types is defined
%   in pred_table.m, and this module uses nothing else exported from
%   pred_table.m either. This is why code generation can succeed
%   without importing pred_table.m, and this is also why we get the warning
%   about pred_table.m being unused if we *do* import it.
%
% I (zs) see three ways of fixing this problem.
%
% - We could have equiv_type.m record, in every item in which it expands out
%   a type equivalence (or, for the same reason, an inst or mode equivalence)
%   defined in a given module, record the name of that module in a new field
%   in that item. In this case, this would mean including the pred_table
%   module in this new field in the pred decl item for
%   module_info_get_pred_id_table. We would preserve the value of this field
%   in the HLDS, e.g. in pred_infos. Then, when the code of this module
%   references module_info_get_pred_id_table, the code generating unused
%   module warnings would consider that reference to use not just the module
%   that defines module_info_get_pred_id_table, but also all the modules
%   recorded in the new "modules that defined expanded equivalences" field
%   of its pred_info. And likewide for other entities that contain types,
%   insts and/or modes that can be expanded.
%
%   This approach would record this information on a per item basis
%   because we want to avoid false positives. If module A imports module B,
%   and module B contains a predicate p that refers to an equivalence type 
%   in module C, this fact should make module C appear used in module A
%   if and only if module A actually *uses* predicate p.
%
% - We could add to every alternative in the mer_type, mer_inst and mer_mode
%   types a new field that records the set of modules that defined the
%   equivalence types, insts or modes in its construction. I mean that if
%   the programmer writes map(pred_id, pred_info), then this set would be
%   empty, but if the prgrammer writes pred_id_table, then, when replacing it
%   with map(pred_id, pred_info), equiv_type.m would include the pred_table
%   module in this set. Every compiler pass *but* unused imports would
%   of course ignore this extra argument.
%
%   A complication here is that unifications of mer_types, mer_insts and
%   mer_modes would have to be done using code that ignores the new fields.
%   Likewise, we wouldn't be able to use values of those types as keys
%   in maps without canonicalizing this field, probably by setting it to the
%   empty set.
%
% - We could simply NOT run equiv_type.m on the augmented compilation unit,
%   and instead expand type equivalences during type checking, and inst and
%   mode equivalences during mode checking. In both cases, we could record
%   the modules defining the types, insts and modes expanded out as being used.
%
% The second solution is probably the easiest to implement, but it also comes
% with a high and persistent memory overhead, which is why I don't think
% it is a good idea. The first solution is the next easiest. The best solution
% is, I think, the third, but it is the hardest to retrofit to our existing
% implementation. (Though it would have been much easier to implement when
% originally writing the type and mode checkers :-()

:- import_module hlds.const_struct.
:- import_module hlds.hlds_class.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_error_util.
:- import_module hlds.hlds_inst_mode.
:- import_module hlds.hlds_out.hlds_out_inst_table.
:- import_module hlds.hlds_out.hlds_out_mode.
:- import_module hlds.hlds_out.hlds_out_pred.
:- import_module hlds.hlds_out.hlds_out_type_table.
:- import_module hlds.hlds_out.hlds_out_typeclass_table.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.hlds_pred.
:- import_module hlds.pred_name.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.parse_tree_out_cons_id.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.parse_tree_out_sym_name.
:- import_module parse_tree.parse_tree_out_type.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_pragma.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.write_error_spec.

:- import_module bool.
:- import_module digraph.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module set.
:- import_module string.
:- import_module varset.

%---------------------------------------------------------------------------%
%
% Write out (selected parts of) the entire HLDS.
%

write_hlds(Stream, ModuleInfo, !IO) :-
    module_info_get_globals(ModuleInfo, Globals),
    globals.lookup_accumulating_option(Globals, dump_hlds_pred_id,
        DumpPredIdStrs),
    globals.lookup_accumulating_option(Globals, dump_hlds_pred_name,
        DumpPredNames),
    globals.lookup_bool_option(Globals, dump_hlds_spec_preds, DumpSpecPreds0),
    globals.lookup_accumulating_option(Globals, dump_hlds_spec_preds_for,
        DumpSpecPredTypeNames),
    write_header(Stream, ModuleInfo, !IO),
    Info = init_hlds_out_info(Globals, output_debug),
    Lang = output_debug,
    DumpOptions0 = Info ^ hoi_dump_hlds_options,
    (
        DumpSpecPredTypeNames = [],
        DumpSpecPreds = DumpSpecPreds0
    ;
        DumpSpecPredTypeNames = [_ | _],
        DumpSpecPreds = yes
    ),
    (
        DumpSpecPreds = no,
        DumpOptions = DumpOptions0
    ;
        DumpSpecPreds = yes,
        % Print unify (and compare and index) predicates.
        DumpOptions = DumpOptions0 ++ "U"
    ),
    ( if
        % If the user specifically requested one or more predicates and/or
        % functions to be dumped, they won't be interested in the types,
        % insts etc.
        ( DumpPredIdStrs = [_ | _]
        ; DumpPredNames = [_ | _]
        ; DumpSpecPreds = yes
        )
    then
        true
    else
        ( if string.contains_char(DumpOptions, 'I') then
            module_info_get_avail_module_map(ModuleInfo, AvailModuleMap),
            map.foldl(write_avail_entry(Stream), AvailModuleMap, !IO)
        else
            true
        ),
        ( if string.contains_char(DumpOptions, 'T') then
            ( if string.contains_char(DumpOptions, 'L') then
                LocalOnly = yes
            else
                LocalOnly = no
            ),
            module_info_get_type_table(ModuleInfo, TypeTable),
            module_info_get_instance_table(ModuleInfo, InstanceTable),
            module_info_get_class_table(ModuleInfo, ClassTable),
            write_type_table(Info, Stream, LocalOnly, TypeTable, !IO),
            write_classes(Info, Stream, ClassTable, !IO),
            write_instances(Info, Stream, InstanceTable, !IO)
        else
            true
        ),
        ( if string.contains_char(DumpOptions, 'M') then
            module_info_get_inst_table(ModuleInfo, InstTable),
            module_info_get_mode_table(ModuleInfo, ModeTable),
            globals.lookup_int_option(Globals, dump_hlds_inst_limit,
                InstNumLimit),
            globals.lookup_int_option(Globals, dump_hlds_inst_size_limit,
                InstSizeLimit),
            write_inst_table(Stream, Lang, InstNumLimit, InstSizeLimit,
                InstTable, !IO),
            write_mode_table(Stream, ModeTable, !IO)
        else
            true
        ),
        ( if string.contains_char(DumpOptions, 'Z') then
            module_info_get_table_struct_map(ModuleInfo, TableStructMap),
            write_table_structs(Stream, ModuleInfo, TableStructMap, !IO)
        else
            true
        )
    ),
    ( if string.contains_char(DumpOptions, 'X') then
        module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
        write_const_struct_db(Stream, ConstStructDb, !IO)
    else
        true
    ),
    ( if
        ( string.contains_char(DumpOptions, 'x')
        ; DumpSpecPreds = yes
        )
    then
        write_preds(Info, Stream, DumpSpecPreds, DumpSpecPredTypeNames,
            Lang, ModuleInfo, !IO)
    else
        true
    ),
    ( if string.contains_char(DumpOptions, 'O') then
        module_info_get_maybe_dependency_info(ModuleInfo, MaybeDependencyInfo),
        (
            MaybeDependencyInfo = no,
            io.write_string(Stream, "% No dependency info\n\n", !IO)
        ;
            MaybeDependencyInfo = yes(DependencyInfo),
            write_dependency_info(Info, Stream, ModuleInfo,
                DependencyInfo, !IO)
        )
    else
        true
    ),
    write_footer(Stream, ModuleInfo, !IO).

%---------------------------------------------------------------------------%

:- pred write_header(io.text_output_stream::in, module_info::in,
    io::di, io::uo) is det.

write_header(Stream, Module, !IO) :-
    module_info_get_name(Module, ModuleName),
    io.write_string(Stream, "% vim: ts=2 sw=2 ft=mercury\n\n", !IO),
    io.format(Stream, ":- module %s.\n\n",
        [s(escaped_sym_name_to_string(ModuleName))], !IO).

:- pred write_footer(io.text_output_stream::in, module_info::in,
    io::di, io::uo) is det.

write_footer(Stream, Module, !IO) :-
    module_info_get_name(Module, ModuleName),
    io.format(Stream, ":- end_module %s.\n",
        [s(escaped_sym_name_to_string(ModuleName))], !IO).

%---------------------------------------------------------------------------%
%
% Write out the imports and uses.
%

:- pred write_avail_entry(io.text_output_stream::in, module_name::in,
    avail_module_entry::in, io::di, io::uo) is det.

write_avail_entry(Stream, ModuleName, Entry, !IO) :-
    Entry = avail_module_entry(Section, ImportOrUse, Avails),
    (
        ImportOrUse = import_decl,
        ImportOrUseDecl = "import_module"
    ;
        ImportOrUse = use_decl,
        ImportOrUseDecl = "use_module"
    ),
    io.format(Stream, ":- %s %s.\n",
        [s(ImportOrUseDecl), s(escaped_sym_name_to_string(ModuleName))], !IO),
    io.write_string(Stream, "% ", !IO),
    io.write(Stream, Section, !IO),
    io.write_string(Stream, ", ", !IO),
    io.write_line(Stream, Avails, !IO).

%---------------------------------------------------------------------------%
%
% Write out constant structs defined in the module.
%

:- pred write_const_struct_db(io.text_output_stream::in, const_struct_db::in,
    io::di, io::uo) is det.

write_const_struct_db(Stream, ConstStructDb, !IO) :-
    const_struct_db_get_structs(ConstStructDb, ConstStructs),
    io.write_string(Stream, "%-------- Const structs --------\n\n", !IO),
    list.foldl(write_const_struct(Stream), ConstStructs, !IO),
    io.nl(Stream, !IO).

:- pred write_const_struct(io.text_output_stream::in,
    pair(int, const_struct)::in, io::di, io::uo) is det.

write_const_struct(Stream, N - ConstStruct, !IO) :-
    io.format(Stream, "\nconst_struct %d:\n", [i(N)], !IO),
    ConstStruct = const_struct(ConsId, ConstArgs, Type, Inst, DefinedWhere),
    mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId,
        Stream, !IO),
    (
        ConstArgs = [],
        io.nl(Stream, !IO)
    ;
        ConstArgs = [HeadConstArg | TailConstArgs],
        io.write_string(Stream, "(\n", !IO),
        write_const_struct_args(Stream, HeadConstArg, TailConstArgs, !IO),
        io.write_string(Stream, ")\n", !IO)
    ),
    io.write_string(Stream, "type: ", !IO),
    mercury_output_type(varset.init, print_name_only, Type, Stream, !IO),
    io.nl(Stream, !IO),
    io.write_string(Stream, "inst: ", !IO),
    mercury_output_structured_inst(Stream, output_debug, varset.init,
        do_not_incl_addr, 0, Inst, !IO),
    (
        DefinedWhere = defined_in_this_module,
        io.write_string(Stream, "defined_in_this_module\n", !IO)
    ;
        DefinedWhere = defined_in_other_module,
        io.write_string(Stream, "defined_in_other_module\n", !IO)
    ).

:- pred write_const_struct_args(io.text_output_stream::in,
    const_struct_arg::in, list(const_struct_arg)::in, io::di, io::uo) is det.

write_const_struct_args(Stream, HeadConstArg, TailConstArgs, !IO) :-
    io.write_string(Stream, "    ", !IO),
    (
        HeadConstArg = csa_const_struct(N),
        io.format(Stream, "cs(%d)", [i(N)], !IO)
    ;
        HeadConstArg = csa_constant(ConsId, Type),
        mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId,
            Stream, !IO),
        io.write_string(Stream, "\n        with type ", !IO),
        mercury_output_type(varset.init, print_name_only, Type, Stream, !IO)
    ),
    (
        TailConstArgs = [],
        io.write_string(Stream, "\n", !IO)
    ;
        TailConstArgs = [HeadTailConstArg | TailTailConstArgs],
        io.write_string(Stream, ",\n", !IO),
        write_const_struct_args(Stream,
            HeadTailConstArg, TailTailConstArgs, !IO)
    ).

%---------------------------------------------------------------------------%
%
% Write out tabling structs defined in the module.
%

:- pred write_table_structs(io.text_output_stream::in, module_info::in,
    table_struct_map::in, io::di, io::uo) is det.

write_table_structs(Stream, ModuleInfo, TableStructMap, !IO) :-
    map.to_assoc_list(TableStructMap, TableStructs),
    io.write_string(Stream, "%-------- Table structs --------\n", !IO),
    list.foldl(write_table_struct_info(Stream, ModuleInfo), TableStructs, !IO),
    io.nl(Stream, !IO).

:- pred write_table_struct_info(io.text_output_stream::in, module_info::in,
    pair(pred_proc_id, table_struct_info)::in, io::di, io::uo) is det.

write_table_struct_info(Stream, ModuleInfo, PredProcId - TableStructInfo,
        !IO) :-
    PredProcIdStr = pred_proc_id_to_dev_string(ModuleInfo, PredProcId),
    io.format(Stream, "\n%% table struct info for %s\n",
        [s(PredProcIdStr)], !IO),
    TableStructInfo = table_struct_info(ProcTableStructInfo, Attributes),
    ProcTableStructInfo = proc_table_struct_info(_ProcLabel, TVarSet, _Context,
        NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, ArgInfos,
        _EvalMethod),
    io.format(Stream, "%% #inputs: %d, #outputs: %d\n",
        [i(NumInputs), i(NumOutputs)], !IO),
    io.write_string(Stream, "% input steps:", !IO),
    list.foldl(write_space_and_table_trie_step(Stream, TVarSet),
        InputSteps, !IO),
    io.nl(Stream, !IO),
    (
        MaybeOutputSteps = yes(OutputSteps),
        io.write_string(Stream, "% output steps:", !IO),
        list.foldl(write_space_and_table_trie_step(Stream, TVarSet),
            OutputSteps, !IO),
        io.nl(Stream, !IO)
    ;
        MaybeOutputSteps = no,
        io.write_string(Stream, "% no output steps", !IO)
    ),
    write_table_arg_infos(Stream, TVarSet, ArgInfos, !IO),

    Attributes = table_attributes(Strictness, SizeLimit, Stats, AllowReset,
        BackendWarning),
    (
        Strictness = cts_all_strict,
        io.write_string(Stream, "% all strict\n", !IO)
    ;
        Strictness = cts_all_fast_loose,
        io.write_string(Stream, "% all fast_loose\n", !IO)
    ;
        Strictness = cts_specified(ArgMethods, HiddenArgMethod),
        io.write_string(Stream, "% specified [", !IO),
        write_arg_tabling_methods(Stream, "", ArgMethods, !IO),
        io.write_string(Stream, "]", !IO),
        (
            HiddenArgMethod = table_hidden_arg_value,
            io.write_string(Stream, ", hidden args by value\n", !IO)
        ;
            HiddenArgMethod = table_hidden_arg_addr,
            io.write_string(Stream, ", hidden args by addr\n", !IO)
        )
    ),
    (
        SizeLimit = no,
        io.write_string(Stream, "% no size limit\n", !IO)
    ;
        SizeLimit = yes(Limit),
        io.format(Stream, "%% size limit %d\n", [i(Limit)], !IO)
    ),
    (
        Stats = table_gather_statistics,
        io.write_string(Stream, "% gather statistics\n", !IO)
    ;
        Stats = table_dont_gather_statistics,
        io.write_string(Stream, "% do not gather statistics\n", !IO)
    ),
    (
        AllowReset = table_allow_reset,
        io.write_string(Stream, "% allow reset\n", !IO)
    ;
        AllowReset = table_dont_allow_reset,
        io.write_string(Stream, "% do not allow reset\n", !IO)
    ),
    (
        BackendWarning = table_attr_ignore_with_warning,
        io.write_string(Stream, "% ignore only with warning\n", !IO)
    ;
        BackendWarning = table_attr_ignore_without_warning,
        io.write_string(Stream, "% may ignore without warning\n", !IO)
    ).

:- pred write_space_and_table_trie_step(io.text_output_stream::in, tvarset::in,
    table_step_desc::in, io::di, io::uo) is det.

write_space_and_table_trie_step(Stream, TVarSet, StepDesc, !IO) :-
    StepDesc = table_step_desc(VarName, TrieStep),
    StepDescStr = table_trie_step_desc(TVarSet, TrieStep),
    io.format(Stream, " %s: %s", [s(VarName), s(StepDescStr)], !IO).

:- func table_trie_step_desc(tvarset, table_trie_step) = string.

table_trie_step_desc(TVarSet, Step) = Str :-
    (
        Step = table_trie_step_int(int_type_int),
        Str = "int"
    ;
        Step = table_trie_step_int(int_type_uint),
        Str = "uint"
    ;
        Step = table_trie_step_int(int_type_int8),
        Str = "int8"
    ;
        Step = table_trie_step_int(int_type_uint8),
        Str = "uint8"
    ;
        Step = table_trie_step_int(int_type_int16),
        Str = "int16"
    ;
        Step = table_trie_step_int(int_type_uint16),
        Str = "uint16"
    ;
        Step = table_trie_step_int(int_type_int32),
        Str = "int32"
    ;
        Step = table_trie_step_int(int_type_uint32),
        Str = "uint32"
    ;
        Step = table_trie_step_int(int_type_int64),
        Str = "int64"
    ;
        Step = table_trie_step_int(int_type_uint64),
        Str = "uint64"
    ;
        Step = table_trie_step_char,
        Str = "char"
    ;
        Step = table_trie_step_string,
        Str = "string"
    ;
        Step = table_trie_step_float,
        Str = "float"
    ;
        Step = table_trie_step_dummy,
        Str = "dummy"
    ;
        Step = table_trie_step_enum(N),
        Str = string.format("enum(%d)", [i(N)])
    ;
        Step = table_trie_step_foreign_enum,
        Str = "foreign_enum"
    ;
        Step = table_trie_step_general(Type, IsPoly, IsAddr),
        TypeStr = mercury_type_to_string(TVarSet, print_name_and_num, Type),
        (
            IsPoly = table_is_poly,
            IsPolyStr = "poly"
        ;
            IsPoly = table_is_mono,
            IsPolyStr = "mono"
        ),
        (
            IsAddr = table_value,
            IsAddrStr = "value"
        ;
            IsAddr = table_addr,
            IsAddrStr = "addr"
        ),
        Str = string.format("general(%s, %s, %s)",
            [s(TypeStr), s(IsPolyStr), s(IsAddrStr)])
    ;
        Step = table_trie_step_typeinfo,
        Str = "typeinfo"
    ;
        Step = table_trie_step_typeclassinfo,
        Str = "typeclassinfo"
    ;
        Step = table_trie_step_promise_implied,
        Str = "promise_implied"
    ).

:- pred write_arg_tabling_methods(io.text_output_stream::in, string::in,
    list(maybe(arg_tabling_method))::in, io::di, io::uo) is det.

write_arg_tabling_methods(_, _, [], !IO).
write_arg_tabling_methods(Stream, Prefix, [MaybeMethod | MaybeMethods], !IO) :-
    io.write_string(Stream, Prefix, !IO),
    (
        MaybeMethod = no,
        io.write_string(Stream, "output", !IO)
    ;
        MaybeMethod = yes(arg_value),
        io.write_string(Stream, "value", !IO)
    ;
        MaybeMethod = yes(arg_addr),
        io.write_string(Stream, "addr", !IO)
    ;
        MaybeMethod = yes(arg_promise_implied),
        io.write_string(Stream, "promise_implied", !IO)
    ),
    write_arg_tabling_methods(Stream, ", ", MaybeMethods, !IO).

%---------------------------------------------------------------------------%
%
% Write out the predicate table.
%

:- pred write_preds(hlds_out_info::in, io.text_output_stream::in,
    bool::in, list(string)::in, output_lang::in, module_info::in,
    io::di, io::uo) is det.

write_preds(Info, Stream, DumpSpecPreds, DumpSpecPredTypeNames, Lang,
        ModuleInfo, !IO) :-
    io.write_string(Stream, "%-------- Predicates --------\n\n", !IO),
    module_info_get_pred_id_table(ModuleInfo, PredIdTable),
    map.to_assoc_list(PredIdTable, PredIdsInfos),
    (
        DumpSpecPreds = no,
        module_info_get_globals(ModuleInfo, Globals),
        globals.lookup_bool_option(Globals, dump_hlds_pred_name_order,
            NameOrder),
        (
            NameOrder = no,
            PrintPredIdsInfos = PredIdsInfos
        ;
            NameOrder = yes,
            list.sort(compare_in_name_order, PredIdsInfos, PrintPredIdsInfos)
        )
    ;
        DumpSpecPreds = yes,
        map.init(SpecPredMap0),
        list.foldl(add_spec_preds_to_map(DumpSpecPredTypeNames), PredIdsInfos,
            SpecPredMap0, SpecPredMap),
        map.values(SpecPredMap, PrintPredIdsInfos)
    ),
    list.foldl(maybe_write_pred(Info, Stream, Lang, ModuleInfo),
        PrintPredIdsInfos, !IO).

:- pred compare_in_name_order(
    pair(pred_id, pred_info)::in,
    pair(pred_id, pred_info)::in,
    comparison_result::out) is det.

compare_in_name_order(PredIdA - PredInfoA, PredIdB - PredInfoB, Result) :-
    pred_info_get_name(PredInfoA, PredNameA),
    pred_info_get_name(PredInfoB, PredNameB),
    compare(NameResult, PredNameA, PredNameB),
    (
        ( NameResult = (<)
        ; NameResult = (>)
        ),
        Result = NameResult
    ;
        NameResult = (=),
        compare(Result, PredIdA, PredIdB)
    ).

:- pred add_spec_preds_to_map(list(string)::in, pair(pred_id, pred_info)::in,
    map({type_ctor, special_pred_id}, pair(pred_id, pred_info))::in,
    map({type_ctor, special_pred_id}, pair(pred_id, pred_info))::out) is det.

add_spec_preds_to_map(DumpSpecPredTypeNames, PredIdInfo, !SpecPredMap) :-
    PredIdInfo = _PredId - PredInfo,
    pred_info_get_origin(PredInfo, Origin),
    ( if Origin = origin_compiler(made_for_uci(SpecialPredId, TypeCtor)) then
        (
            DumpSpecPredTypeNames = [],
            map.det_insert({TypeCtor, SpecialPredId}, PredIdInfo, !SpecPredMap)
        ;
            DumpSpecPredTypeNames = [_ | _],
            TypeCtor = type_ctor(TypeCtorSymName, _TypeCtorArity),
            TypeCtorName = unqualify_name(TypeCtorSymName),
            ( if list.member(TypeCtorName, DumpSpecPredTypeNames) then
                map.det_insert({TypeCtor, SpecialPredId}, PredIdInfo,
                    !SpecPredMap)
            else
                true
            )
        )
    else
        true
    ).

:- pred maybe_write_pred(hlds_out_info::in, io.text_output_stream::in,
    output_lang::in, module_info::in, pair(pred_id, pred_info)::in,
    io::di, io::uo) is det.

maybe_write_pred(Info, Stream, Lang, ModuleInfo, PredId - PredInfo,
        !IO) :-
    DumpOptions = Info ^ hoi_dump_hlds_options,
    DumpPredIdStrs = Info ^ hoi_dump_hlds_pred_ids,
    DumpPredNames = Info ^ hoi_dump_hlds_pred_names,
    pred_id_to_int(PredId, PredIdInt),
    ( if
        % If the user requested one or more predicates/functions to be dumped,
        % we dump them even if the condition of the nested if-then-else below
        % would say they shouldn't be dumped, and we don't dump anything else.
        ( DumpPredIdStrs = [_ | _]
        ; DumpPredNames = [_ | _]
        )
    then
        ( if
            (
                some [DumpPredIdStr, DumpPredId] (
                    list.member(DumpPredIdStr, DumpPredIdStrs),
                    string.to_int(DumpPredIdStr, DumpPredId),
                    PredIdInt = DumpPredId
                )
            ;
                PredName = pred_info_name(PredInfo),
                list.member(PredName, DumpPredNames)
            )
        then
            write_pred(Info, Stream, Lang, ModuleInfo, PredId, PredInfo, !IO)
        else
            true
        )
    else
        ( if
            (
                not string.contains_char(DumpOptions, 'I'),
                pred_info_is_imported(PredInfo)
            ;
                % For pseudo-imported predicates (i.e. unification preds),
                % only print them if we are using a local mode for them.
                not string.contains_char(DumpOptions, 'I'),
                pred_info_is_pseudo_imported(PredInfo),
                ProcIds = pred_info_all_procids(PredInfo),
                hlds_pred.in_in_unification_proc_id(ProcId),
                ProcIds = [ProcId]
            ;
                % We dump unification and other compiler-generated special
                % predicates if suboption 'U' is on. We don't need that
                % information to understand how the program has been
                % transformed.
                not string.contains_char(DumpOptions, 'U'),
                is_unify_index_or_compare_pred(PredInfo)
            )
        then
            true
        else
            write_pred(Info, Stream, Lang, ModuleInfo, PredId, PredInfo, !IO)
        )
    ).

%---------------------------------------------------------------------------%
%
% Write out dependency information.
%

:- pred write_dependency_info(hlds_out_info::in, io.text_output_stream::in,
    module_info::in, hlds_dependency_info::in, io::di, io::uo) is det.

write_dependency_info(_Info, Stream, ModuleInfo, DependencyInfo, !IO) :-
    io.write_string(Stream, "% Dependency graph\n\n", !IO),
    Graph = dependency_info_get_graph(DependencyInfo),
    digraph.traverse(Graph,
        write_dep_graph_node(Stream, ModuleInfo),
        write_dep_graph_edge(Stream, ModuleInfo), !IO),

% If needed, this code can be used to check the raw behavior
% of digraph operations.
%
%   ( if tsort(Graph, TSort) then
%       write_indent(Stream, Indent, !IO),
%       io.write_string(Stream, "\n% TSORT ordering\n\n", !IO),
%       list.foldl(write_dependency_proc(Indent, "", ModuleInfo), TSort, !IO)
%   else
%       io.write_string(Stream, "\n% NO TSORT ordering\n\n", !IO)
%   ),
%
%   write_indent(Stream, Indent, !IO),
%   io.write_string(Stream, "\n% ATSORT ordering\n\n", !IO),
%   AtSort = digraph.atsort(Graph),
%   list.foldl(write_dependency_scc(Indent, ModuleInfo), AtSort, !IO),

    io.write_string(Stream, "\n% Bottom up dependency sccs\n\n", !IO),
    Ordering = dependency_info_get_bottom_up_sccs(DependencyInfo),
    list.foldl(write_dependency_scc(Stream, ModuleInfo), Ordering, !IO).

:- pred write_dep_graph_node(io.text_output_stream::in, module_info::in,
    pred_proc_id::in, io::di, io::uo) is det.

write_dep_graph_node(Stream, ModuleInfo, Proc, !IO) :-
    write_dependency_proc(Stream, "calls from ", ModuleInfo, Proc, !IO).

:- pred write_dep_graph_edge(io.text_output_stream::in, module_info::in,
    pred_proc_id::in, pred_proc_id::in, io::di, io::uo) is det.

write_dep_graph_edge(Stream, ModuleInfo, _ParentProc, ChildProc, !IO) :-
    write_dependency_proc(Stream, "  to ", ModuleInfo, ChildProc, !IO).

:- pred write_dependency_scc(io.text_output_stream::in, module_info::in,
    scc::in, io::di, io::uo) is det.

write_dependency_scc(Stream, ModuleInfo, SCC, !IO) :-
    io.write_string(Stream, "% SCC\n", !IO),
    set.foldl(write_dependency_proc(Stream, "  ", ModuleInfo), SCC, !IO).

:- pred write_dependency_proc(io.text_output_stream::in, string::in,
    module_info::in, pred_proc_id::in, io::di, io::uo) is det.

write_dependency_proc(Stream, Prefix, ModuleInfo, PredProcId, !IO) :-
    PredProcId = proc(PredId, ProcId),
    Pieces = describe_one_proc_name(ModuleInfo,
        should_not_module_qualify, PredProcId),
    Desc = error_pieces_to_one_line_string(Pieces),

    io.format(Stream, "%% %spred %d proc %d, %s\n",
        [s(Prefix), i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId)),
        s(Desc)], !IO).

%---------------------------------------------------------------------------%
:- end_module hlds.hlds_out.hlds_out_module.
%---------------------------------------------------------------------------%
