%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2009-2012 The University of Melbourne.
% Copyright (C) 2014-2024 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: 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.
:- func hlds_to_string(module_info) = string.

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

:- 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 format_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 likewise 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 programmer 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 string.builder.
:- import_module varset.

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

write_hlds(Stream, ModuleInfo, !IO) :-
    Str = hlds_to_string(ModuleInfo),
    io.write_string(Stream, Str, !IO).

hlds_to_string(ModuleInfo) = Str :-
    State0 = string.builder.init,
    format_hlds(ModuleInfo, State0, State),
    Str = string.builder.to_string(State).

:- pred format_hlds(module_info::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_hlds(ModuleInfo, !State) :-
    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),
    format_header(ModuleInfo, !State),
    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(format_avail_entry, AvailModuleMap, !State)
        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),
            format_type_table(Info, LocalOnly, TypeTable, !State),
            format_classes(Info, ClassTable, !State),
            format_instances(Info, InstanceTable, !State)
        else
            true
        ),
        ( if string.contains_char(DumpOptions, 'M') then
            module_info_get_inst_table(ModuleInfo, InstTable),
            module_info_get_mode_table(ModuleInfo, ModeTable),
            ( if string.contains_char(DumpOptions, 'Y') then
                MaybeUseErrorMsgInst = use_error_msg_inst(ModuleInfo)
            else
                MaybeUseErrorMsgInst = do_not_use_error_msg_inst
            ),
            globals.lookup_int_option(Globals, dump_hlds_inst_limit,
                InstNumLimit),
            globals.lookup_int_option(Globals, dump_hlds_inst_size_limit,
                InstSizeLimit),
            format_inst_table(Lang, MaybeUseErrorMsgInst,
                InstNumLimit, InstSizeLimit, InstTable, !State),
            format_mode_table(ModeTable, !State)
        else
            true
        ),
        ( if string.contains_char(DumpOptions, 'Z') then
            module_info_get_table_struct_map(ModuleInfo, TableStructMap),
            format_table_structs(ModuleInfo, TableStructMap, !State)
        else
            true
        )
    ),
    ( if string.contains_char(DumpOptions, 'X') then
        module_info_get_const_struct_db(ModuleInfo, ConstStructDb),
        format_const_struct_db(ConstStructDb, !State)
    else
        true
    ),
    ( if
        ( string.contains_char(DumpOptions, 'x')
        ; DumpSpecPreds = yes
        )
    then
        format_preds(Info, DumpSpecPreds, DumpSpecPredTypeNames, Lang,
            ModuleInfo, !State)
    else
        true
    ),
    ( if string.contains_char(DumpOptions, 'O') then
        module_info_get_maybe_dependency_info(ModuleInfo, MaybeDependencyInfo),
        (
            MaybeDependencyInfo = no,
            string.builder.append_string("% No dependency info\n\n", !State)
        ;
            MaybeDependencyInfo = yes(DependencyInfo),
            format_dependency_info(Info, ModuleInfo, DependencyInfo, !State)
        )
    else
        true
    ),
    format_footer(ModuleInfo, !State).

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

:- pred format_header(module_info::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_header(Module, !State) :-
    module_info_get_name(Module, ModuleName),
    string.builder.append_string("% vim: ts=2 sw=2 ft=mercury\n\n", !State),
    string.builder.format(":- module %s.\n\n",
        [s(escaped_sym_name_to_string(ModuleName))], !State).

:- pred format_footer(module_info::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_footer(Module, !State) :-
    module_info_get_name(Module, ModuleName),
    string.builder.format(":- end_module %s.\n",
        [s(escaped_sym_name_to_string(ModuleName))], !State).

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

:- pred format_avail_entry(module_name::in, avail_module_entry::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_avail_entry(ModuleName, Entry, !State) :-
    Entry = avail_module_entry(Section, ImportOrUse, Avails),
    (
        ImportOrUse = import_decl,
        ImportOrUseDecl = "import_module"
    ;
        ImportOrUse = use_decl,
        ImportOrUseDecl = "use_module"
    ),
    string.builder.format(":- %s %s.\n",
        [s(ImportOrUseDecl), s(escaped_sym_name_to_string(ModuleName))],
        !State),
    string.builder.format("%% %s, %s\n",
        [s(string.string(Section)), s(string.string(Avails))], !State).

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

:- pred format_const_struct_db(const_struct_db::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_const_struct_db(ConstStructDb, !State) :-
    const_struct_db_get_structs(ConstStructDb, ConstStructs),
    string.builder.append_string(
        "%-------- Const structs --------\n\n", !State),
    list.foldl(format_const_struct, ConstStructs, !State),
    string.builder.append_string("\n", !State).

:- pred format_const_struct(pair(int, const_struct)::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_const_struct(N - ConstStruct, !State) :-
    string.builder.format("\nconst_struct %d:\n", [i(N)], !State),
    ConstStruct = const_struct(ConsId, ConstArgs, Type, Inst, DefinedWhere),
    mercury_format_cons_id(output_debug, does_not_need_brackets, ConsId,
        string.builder.handle, !State),
    (
        ConstArgs = [],
        string.builder.append_string("\n", !State)
    ;
        ConstArgs = [HeadConstArg | TailConstArgs],
        string.builder.append_string("(\n", !State),
        format_const_struct_args(HeadConstArg, TailConstArgs, !State),
        string.builder.append_string(")\n", !State)
    ),
    string.builder.append_string("type: ", !State),
    mercury_format_type(varset.init, print_name_only, Type,
        string.builder.handle, !State),
    string.builder.append_string("\n", !State),
    string.builder.append_string("inst: ", !State),
    mercury_format_structured_inst(output_debug, varset.init, do_not_incl_addr,
        0u, "\n", Inst, string.builder.handle, !State),
    (
        DefinedWhere = defined_in_this_module,
        string.builder.append_string("defined_in_this_module\n", !State)
    ;
        DefinedWhere = defined_in_other_module,
        string.builder.append_string("defined_in_other_module\n", !State)
    ).

:- pred format_const_struct_args(const_struct_arg::in,
    list(const_struct_arg)::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_const_struct_args(HeadConstArg, TailConstArgs, !State) :-
    string.builder.append_string("    ", !State),
    (
        HeadConstArg = csa_const_struct(N),
        string.builder.format("cs(%d)", [i(N)], !State)
    ;
        HeadConstArg = csa_constant(ConsId, Type),
        mercury_format_cons_id(output_debug, does_not_need_brackets, ConsId,
            string.builder.handle, !State),
        string.builder.append_string("\n        with type ", !State),
        mercury_format_type(varset.init, print_name_only, Type,
            string.builder.handle, !State)
    ),
    (
        TailConstArgs = [],
        string.builder.append_string("\n", !State)
    ;
        TailConstArgs = [HeadTailConstArg | TailTailConstArgs],
        string.builder.append_string(",\n", !State),
        format_const_struct_args(HeadTailConstArg, TailTailConstArgs, !State)
    ).

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

:- pred format_table_structs(module_info::in, table_struct_map::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_table_structs(ModuleInfo, TableStructMap, !State) :-
    map.to_assoc_list(TableStructMap, TableStructs),
    string.builder.append_string("%-------- Table structs --------\n", !State),
    list.foldl(format_table_struct_info(ModuleInfo), TableStructs, !State),
    string.builder.append_string("\n", !State).

:- pred format_table_struct_info(module_info::in,
    pair(pred_proc_id, table_struct_info)::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_table_struct_info(ModuleInfo, PredProcId - TableStructInfo,
        !State) :-
    PredProcIdStr = pred_proc_id_to_dev_string(ModuleInfo, PredProcId),
    string.builder.format("\n%% table struct info for %s\n",
        [s(PredProcIdStr)], !State),
    TableStructInfo = table_struct_info(ProcTableStructInfo, Attributes),
    ProcTableStructInfo = proc_table_struct_info(_ProcLabel, TVarSet, _Context,
        NumInputs, NumOutputs, InputSteps, MaybeOutputSteps, ArgInfos,
        _EvalMethod),
    string.builder.format("%% #inputs: %d, #outputs: %d\n",
        [i(NumInputs), i(NumOutputs)], !State),
    string.builder.append_string("% input steps:", !State),
    list.foldl(format_space_and_table_trie_step(TVarSet),
        InputSteps, !State),
    string.builder.append_string("\n", !State),
    (
        MaybeOutputSteps = yes(OutputSteps),
        string.builder.append_string("% output steps:", !State),
        list.foldl(format_space_and_table_trie_step(TVarSet),
            OutputSteps, !State),
        string.builder.append_string("\n", !State)
    ;
        MaybeOutputSteps = no,
        string.builder.append_string("% no output steps", !State)
    ),
    format_table_arg_infos(TVarSet, ArgInfos, !State),

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

:- pred format_space_and_table_trie_step(tvarset::in, table_step_desc::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_space_and_table_trie_step(TVarSet, StepDesc, !State) :-
    StepDesc = table_step_desc(VarName, TrieStep),
    StepDescStr = table_trie_step_desc(TVarSet, TrieStep),
    string.builder.format(" %s: %s", [s(VarName), s(StepDescStr)], !State).

:- 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 format_arg_tabling_methods(string::in,
    list(maybe(arg_tabling_method))::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_arg_tabling_methods(_, [], !State).
format_arg_tabling_methods(Prefix, [MaybeMethod | MaybeMethods], !State) :-
    string.builder.append_string(Prefix, !State),
    (
        MaybeMethod = no,
        string.builder.append_string("output", !State)
    ;
        MaybeMethod = yes(arg_value),
        string.builder.append_string("value", !State)
    ;
        MaybeMethod = yes(arg_addr),
        string.builder.append_string("addr", !State)
    ;
        MaybeMethod = yes(arg_promise_implied),
        string.builder.append_string("promise_implied", !State)
    ),
    format_arg_tabling_methods(", ", MaybeMethods, !State).

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

:- pred format_preds(hlds_out_info::in, bool::in, list(string)::in,
    output_lang::in, module_info::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_preds(Info, DumpSpecPreds, DumpSpecPredTypeNames, Lang,
        ModuleInfo, !State) :-
    string.builder.append_string("%-------- Predicates --------\n\n", !State),
    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, Lang, ModuleInfo),
        PrintPredIdsInfos, !State).

:- 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, output_lang::in, module_info::in,
    pair(pred_id, pred_info)::in,
    string.builder.state::di, string.builder.state::uo) is det.

maybe_write_pred(Info, Lang, ModuleInfo, PredId - PredInfo, !State) :-
    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
            format_pred(Info, Lang, ModuleInfo, PredId, PredInfo, !State)
        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
            format_pred(Info, Lang, ModuleInfo, PredId, PredInfo, !State)
        )
    ).

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

:- pred format_dependency_info(hlds_out_info::in, module_info::in,
    hlds_dependency_info::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_dependency_info(_Info, ModuleInfo, DependencyInfo, !State) :-
    string.builder.append_string("% Dependency graph\n\n", !State),
    Graph = dependency_info_get_graph(DependencyInfo),
    digraph.traverse(Graph,
        format_dep_graph_node(ModuleInfo),
        format_dep_graph_edge(ModuleInfo), !State),

% If needed, this code can be used to check the raw behavior
% of digraph operations.
%
%   ( if tsort(Graph, TSort) then
%       format_indent(Indent, !State),
%       string.builder.append_string("\n% TSORT ordering\n\n", !State),
%       list.foldl(format_dependency_proc(Indent, "", ModuleInfo),
%           TSort, !State)
%   else
%       string.builder.append_string("\n% NO TSORT ordering\n\n", !State)
%   ),
%
%   format_indent(Indent, !State),
%   string.builder.append_string("\n% ATSORT ordering\n\n", !State),
%   AtSort = digraph.atsort(Graph),
%   list.foldl(format_dependency_scc(Indent, ModuleInfo), AtSort, !State),

    string.builder.append_string("\n% Bottom up dependency sccs\n\n", !State),
    Ordering = dependency_info_get_bottom_up_sccs(DependencyInfo),
    list.foldl(format_dependency_scc(ModuleInfo), Ordering, !State).

:- pred format_dep_graph_node(module_info::in, pred_proc_id::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_dep_graph_node(ModuleInfo, Proc, !State) :-
    format_dependency_proc("calls from ", ModuleInfo, Proc, !State).

:- pred format_dep_graph_edge(module_info::in,
    pred_proc_id::in, pred_proc_id::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_dep_graph_edge(ModuleInfo, _ParentProc, ChildProc, !State) :-
    format_dependency_proc("  to ", ModuleInfo, ChildProc, !State).

:- pred format_dependency_scc(module_info::in, scc::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_dependency_scc(ModuleInfo, SCC, !State) :-
    string.builder.append_string("% SCC\n", !State),
    set.foldl(format_dependency_proc("  ", ModuleInfo), SCC, !State).

:- pred format_dependency_proc(string::in, module_info::in, pred_proc_id::in,
    string.builder.state::di, string.builder.state::uo) is det.

format_dependency_proc(Prefix, ModuleInfo, PredProcId, !State) :-
    PredProcId = proc(PredId, ProcId),
    Pieces = describe_unqual_proc_name(ModuleInfo, PredProcId),
    Desc = error_pieces_to_one_line_string(Pieces),

    string.builder.format("%% %spred %d proc %d, %s\n",
        [s(Prefix), i(pred_id_to_int(PredId)), i(proc_id_to_int(ProcId)),
        s(Desc)], !State).

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