mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 10:23:46 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/compiler/parse_tree_out.m
Zoltan Somogyi 6bdd8b84ee Move maybe_changed to maybe_succeeded.m and rename it. 
compiler/maybe_util.m:
    Move the maybe_changed type from several modules of the compiler
    to maybe_succeeded.m, and rename it to maybe_util.m.

compiler/libs.m:
compiler/notes/compiler_design.html:
    Implement and document the rename.

compiler/common.m:
compiler/compile_target_code.m:
compiler/decide_type_repn.m:
compiler/det_analysis.m:
compiler/det_util.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/file_util.m:
compiler/llds_out_file.m:
compiler/make.build.m:
compiler/make.dependencies.m:
compiler/make.module_dep_file.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.top_level.m:
compiler/make.track_flags.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_mlds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_type.m:
compiler/mlds_to_cs_file.m:
compiler/mlds_to_java_file.m:
compiler/module_cmds.m:
compiler/parse_tree_out.m:
compiler/process_util.m:
compiler/recompilation.version.m:
compiler/write_module_interface_files.m:
    Conform to the changes above.
2023-04-21 17:24:30 +10:00

2220 lines
93 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015-2021 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.
%---------------------------------------------------------------------------%
%
% This module converts the top levels of the parse tree structure
% back into Mercury source text.
%
%---------------------------------------------------------------------------%
:- module parse_tree.parse_tree_out.
:- interface.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.maybe_util.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_item.
:- import_module io.
:- import_module list.
:- import_module maybe.
%---------------------------------------------------------------------------%
% output_parse_tree_*(ProgressStream, ErrorStream, Globals,
% OutputFileName, ParseTree, !IO).
:- pred output_parse_tree_src(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_src::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_int0(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_int0::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_int1(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_int1::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_int2(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_int2::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_int3(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_int3::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_plain_opt(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_plain_opt::in, maybe_succeeded::out,
io::di, io::uo) is det.
:- pred output_parse_tree_trans_opt(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, parse_tree_trans_opt::in, maybe_succeeded::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
:- pred mercury_output_parse_tree_src(merc_out_info::in,
io.text_output_stream::in, parse_tree_src::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_module_src(merc_out_info::in,
io.text_output_stream::in, parse_tree_module_src::in,
io::di, io::uo) is det.
:- pred mercury_output_ancestor_int_spec(merc_out_info::in,
io.text_output_stream::in, ancestor_int_spec::in, io::di, io::uo) is det.
:- pred mercury_output_direct_int1_spec(merc_out_info::in,
io.text_output_stream::in, direct_int1_spec::in, io::di, io::uo) is det.
:- pred mercury_output_direct_int3_spec(merc_out_info::in,
io.text_output_stream::in, direct_int3_spec::in, io::di, io::uo) is det.
:- pred mercury_output_indirect_int2_spec(merc_out_info::in,
io.text_output_stream::in, indirect_int2_spec::in, io::di, io::uo) is det.
:- pred mercury_output_indirect_int3_spec(merc_out_info::in,
io.text_output_stream::in, indirect_int3_spec::in, io::di, io::uo) is det.
:- pred mercury_output_int_for_opt_spec(merc_out_info::in,
io.text_output_stream::in, int_for_opt_spec::in, io::di, io::uo) is det.
:- pred mercury_output_type_repn_spec(merc_out_info::in,
io.text_output_stream::in, type_repn_spec::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_int0(merc_out_info::in,
io.text_output_stream::in, parse_tree_int0::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_int1(merc_out_info::in,
io.text_output_stream::in, parse_tree_int1::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_int2(merc_out_info::in,
io.text_output_stream::in, parse_tree_int2::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_int3(merc_out_info::in,
io.text_output_stream::in, parse_tree_int3::in, io::di, io::uo) is det.
:- pred mercury_output_parse_tree_plain_opt(merc_out_info::in,
io.text_output_stream::in, parse_tree_plain_opt::in,
io::di, io::uo) is det.
:- pred mercury_output_parse_tree_trans_opt(merc_out_info::in,
io.text_output_stream::in, parse_tree_trans_opt::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% mercury_output_module_decl(Stream, Decl, ModuleName, !IO)
%
:- pred mercury_output_module_decl(io.text_output_stream::in,
string::in, module_name::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
:- pred mercury_output_item(merc_out_info::in, io.text_output_stream::in,
item::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%
% Output some components of type definitions.
%
:- pred mercury_output_item_type_defn(merc_out_info::in,
io.text_output_stream::in, item_type_defn_info::in, io::di, io::uo) is det.
:- pred mercury_output_where_attributes(merc_out_info::in, tvarset::in,
maybe(solver_type_details)::in, maybe_canonical::in,
maybe(list(sym_name_arity))::in, io.text_output_stream::in,
io::di, io::uo) is det.
:- pred mercury_output_ctor(tvarset::in, constructor::in,
io.text_output_stream::in, io::di, io::uo) is det.
:- pred maybe_cons_exist_constraints_to_prefix_suffix(tvarset::in,
string::in, string::in, maybe_cons_exist_constraints::in,
string::out, string::out) is det.
:- pred maybe_brace_for_name_prefix_suffix(arity::in, string::in,
string::out, string::out) is det.
%---------------------------------------------------------------------------%
:- pred mercury_output_item_inst_defn(merc_out_info::in,
io.text_output_stream::in, item_inst_defn_info::in, io::di, io::uo) is det.
:- pred mercury_output_item_mode_defn(merc_out_info::in,
io.text_output_stream::in, item_mode_defn_info::in, io::di, io::uo) is det.
:- pred mercury_output_item_pred_decl(output_lang::in, var_name_print::in,
io.text_output_stream::in, item_pred_decl_info::in, io::di, io::uo) is det.
:- pred mercury_output_item_mode_decl(merc_out_info::in,
io.text_output_stream::in, item_mode_decl_info::in, io::di, io::uo) is det.
:- pred mercury_format_item_foreign_enum(merc_out_info::in, S::in,
item_foreign_enum_info::in, U::di, U::uo) is det <= output(S, U).
:- pred mercury_output_item_typeclass(merc_out_info::in,
io.text_output_stream::in, item_typeclass_info::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%
% Output some components of an instance definition.
%
:- pred mercury_output_item_instance(merc_out_info::in,
io.text_output_stream::in, item_instance_info::in, io::di, io::uo) is det.
:- pred mercury_output_instance_method(instance_method::in,
io.text_output_stream::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%
% Output a foreign_import_module pragma.
%
:- pred mercury_output_fim_spec(io.text_output_stream::in, fim_spec::in,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% Print a blank line if the given list is not empty.
%
:- pred maybe_write_block_start_blank_line(io.text_output_stream::in,
list(T)::in, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.canonicalize_interface.
:- import_module parse_tree.item_util.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.parse_inst_mode_name.
:- import_module parse_tree.parse_tree_out_clause.
:- import_module parse_tree.parse_tree_out_inst.
:- import_module parse_tree.parse_tree_out_misc.
:- import_module parse_tree.parse_tree_out_pragma.
:- import_module parse_tree.parse_tree_out_pred_decl.
:- import_module parse_tree.parse_tree_out_sym_name.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.parse_tree_out_type.
:- import_module parse_tree.parse_tree_out_type_repn.
:- import_module parse_tree.prog_util.
:- import_module recompilation.
:- import_module recompilation.version.
:- import_module assoc_list.
:- import_module bool.
:- import_module char.
:- import_module cord.
:- import_module map.
:- import_module one_or_more.
:- import_module pair.
:- import_module set.
:- import_module string.
:- import_module term.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
output_parse_tree_src(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeSrc, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_src, ParseTreeSrc,
Succeeded, !IO).
%---------------------%
output_parse_tree_int0(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeInt0, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_int0, ParseTreeInt0,
Succeeded, !IO).
output_parse_tree_int1(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeInt1, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_int1, ParseTreeInt1,
Succeeded, !IO).
output_parse_tree_int2(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeInt2, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_int2, ParseTreeInt2,
Succeeded, !IO).
output_parse_tree_int3(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeInt3, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_int3, ParseTreeInt3,
Succeeded, !IO).
%---------------------%
output_parse_tree_plain_opt(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreePlainOpt, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_plain_opt, ParseTreePlainOpt,
Succeeded, !IO).
output_parse_tree_trans_opt(ProgressStream, ErrorStream, Globals,
OutputFileName, ParseTreeTransOpt, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, mercury_output_parse_tree_trans_opt, ParseTreeTransOpt,
Succeeded, !IO).
%---------------------------------------------------------------------------%
:- type output_parse_tree(PT) ==
pred(merc_out_info, io.text_output_stream, PT, io, io).
:- inst output_parse_tree == (pred(in, in, in, di, uo) is det).
:- pred output_some_parse_tree(
io.text_output_stream::in, io.text_output_stream::in, globals::in,
string::in, output_parse_tree(PT)::in(output_parse_tree),
PT::in, maybe_succeeded::out, io::di, io::uo) is det.
output_some_parse_tree(ProgressStream, ErrorStream, Globals,
OutputFileName, OutputParseTree, ParseTree, Succeeded, !IO) :-
io.open_output(OutputFileName, Res, !IO),
(
Res = ok(FileStream),
globals.lookup_bool_option(Globals, verbose, Verbose),
(
Verbose = yes,
io.format(ProgressStream, "%% Writing output to %s...",
[s(OutputFileName)], !IO),
io.flush_output(ProgressStream, !IO)
;
Verbose = no
),
% Module qualifiers on items are redundant after the
% declaration above.
% XXX What declaration?
Info = init_merc_out_info(Globals, unqualified_item_names,
output_mercury),
OutputParseTree(Info, FileStream, ParseTree, !IO),
io.close_output(FileStream, !IO),
(
Verbose = yes,
io.write_string(ProgressStream, " done\n", !IO)
;
Verbose = no
),
Succeeded = succeeded
;
Res = error(_),
io.format(ErrorStream,
"Error: couldn't open file `%s' for output.\n",
[s(OutputFileName)], !IO),
Succeeded = did_not_succeed
).
%---------------------------------------------------------------------------%
mercury_output_parse_tree_src(Info, Stream, ParseTree, !IO) :-
ParseTree = parse_tree_src(ModuleName, _Context, ModuleComponentsCord),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
ModuleComponents = cord.list(ModuleComponentsCord),
mercury_output_module_components(Info, Stream, no, ModuleComponents, !IO),
mercury_output_module_decl(Stream, "end_module", ModuleName, !IO).
mercury_output_parse_tree_module_src(Info, Stream, ParseTreeModuleSrc, !IO) :-
ParseTreeModuleSrc = parse_tree_module_src(ModuleName, _ModuleContext,
IntIncludeMap, ImpIncludeMap, InclMap,
IntImportMap, IntUseMap, ImpImportMap, ImpUseMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
_TypeSpecs, _InstModeSpecs,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntPromises, _IntBadPreds,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls, ImpClauses,
ImpForeignExportEnums, ImpDeclPragmas, ImpImplPragmas, ImpPromises,
ImpInitialises, ImpFinalises, ImpMutables),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, ImpModeDefns),
io.write_string(Stream, "% module src\n", !IO),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
io.write_string(Stream, "% include_module_map\n", !IO),
map.foldl(write_include_module_map_entry(Stream), InclMap, !IO),
io.write_string(Stream, "% section_import_and_or_use_map\n", !IO),
map.foldl(write_import_use_map_entry(Stream), ImportUseMap, !IO),
mercury_output_section_marker(Stream, ms_interface, !IO),
list.foldl(mercury_output_module_decl(Stream, "include_module"),
map.keys(IntIncludeMap), !IO),
list.foldl(mercury_output_module_decl(Stream, "import_module"),
map.keys(IntImportMap), !IO),
list.foldl(mercury_output_module_decl(Stream, "use_module"),
map.keys(IntUseMap), !IO),
list.foldl(mercury_output_fim_spec(Stream), map.keys(IntFIMSpecMap), !IO),
IntSelfFIMLangStrs = list.map(mercury_foreign_language_to_string,
set.to_sorted_list(IntSelfFIMLangs)),
ImpSelfFIMLangStrs = list.map(mercury_foreign_language_to_string,
set.to_sorted_list(ImpSelfFIMLangs)),
io.format(Stream,
"%% implicit interface FIM self-import languages: %s\n",
[s(string.join_list(", ", IntSelfFIMLangStrs))], !IO),
io.format(Stream,
"%% implicit implementation FIM self-import languages: %s\n",
[s(string.join_list(", ", ImpSelfFIMLangStrs))], !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
IntTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
IntInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
IntModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
IntTypeClasses, !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
IntInstances, !IO),
list.foldl(
mercury_output_item_pred_decl_mu_mc(Info, print_name_only, Stream),
IntPredDecls, !IO),
list.foldl(mercury_output_item_mode_decl(Info, Stream),
IntModeDecls, !IO),
list.foldl(mercury_output_item_decl_pragma(Info, Stream),
IntDeclPragmas, !IO),
list.foldl(mercury_output_item_promise(Info, Stream),
IntPromises, !IO),
mercury_output_section_marker(Stream, ms_implementation, !IO),
list.foldl(mercury_output_module_decl(Stream, "include_module"),
map.keys(ImpIncludeMap), !IO),
list.foldl(mercury_output_module_decl(Stream, "import_module"),
map.keys(ImpImportMap), !IO),
list.foldl(mercury_output_module_decl(Stream, "use_module"),
map.keys(ImpUseMap), !IO),
list.foldl(mercury_output_fim_spec(Stream), map.keys(ImpFIMSpecMap), !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
ImpTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
ImpInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
ImpModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
ImpTypeClasses, !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
ImpInstances, !IO),
list.foldl(
mercury_output_item_pred_decl_mu_mc(Info, print_name_only, Stream),
ImpPredDecls, !IO),
list.foldl(mercury_output_item_mode_decl(Info, Stream),
ImpModeDecls, !IO),
list.foldl(mercury_output_item_clause(Info, Stream),
ImpClauses, !IO),
list.foldl(mercury_format_item_foreign_enum(Info, Stream),
ImpForeignEnums, !IO),
add_list(mercury_format_item_foreign_export_enum(Info),
"", ImpForeignExportEnums, Stream, !IO),
list.foldl(mercury_output_item_decl_pragma(Info, Stream),
ImpDeclPragmas, !IO),
list.foldl(mercury_output_item_impl_pragma(Info, Stream),
ImpImplPragmas, !IO),
list.foldl(mercury_output_item_promise(Info, Stream),
ImpPromises, !IO),
list.foldl(mercury_output_item_initialise(Info, Stream),
ImpInitialises, !IO),
list.foldl(mercury_output_item_finalise(Info, Stream),
ImpFinalises, !IO),
list.foldl(mercury_output_item_mutable(Info, Stream),
ImpMutables, !IO),
mercury_output_module_decl(Stream, "end_module", ModuleName, !IO),
io.nl(Stream, !IO).
:- pred write_include_module_map_entry(io.text_output_stream::in,
module_name::in, include_module_info::in, io::di, io::uo) is det.
write_include_module_map_entry(Stream, ModuleName, InclInfo, !IO) :-
InclInfo = include_module_info(Section, _Context),
io.write_string(Stream, "% ", !IO),
mercury_output_bracketed_sym_name(ModuleName, Stream, !IO),
io.write_string(Stream, " -> ", !IO),
(
Section = ms_interface,
io.write_string(Stream, "interface", !IO)
;
Section = ms_implementation,
io.write_string(Stream, "implementation", !IO)
),
io.nl(Stream, !IO).
:- pred write_import_use_map_entry(io.text_output_stream::in, module_name::in,
maybe_implicit_import_and_or_use::in, io::di, io::uo) is det.
write_import_use_map_entry(Stream, ModuleName, ImportAndOrUse, !IO) :-
io.write_string(Stream, "% ", !IO),
mercury_output_bracketed_sym_name(ModuleName, Stream, !IO),
io.write_string(Stream, " -> ", !IO),
(
ImportAndOrUse = explicit_avail(SectionImportAndOrUse),
(
SectionImportAndOrUse = int_import(_),
io.write_string(Stream, "int_import", !IO)
;
SectionImportAndOrUse = int_use(_),
io.write_string(Stream, "int_use", !IO)
;
SectionImportAndOrUse = imp_import(_),
io.write_string(Stream, "imp_import", !IO)
;
SectionImportAndOrUse = imp_use(_),
io.write_string(Stream, "imp_use", !IO)
;
SectionImportAndOrUse = int_use_imp_import(_, _),
io.write_string(Stream, "int_use_imp_import", !IO)
)
;
ImportAndOrUse = implicit_avail(ImplicitImportAndOrUse, _),
(
ImplicitImportAndOrUse = implicit_int_import,
io.write_string(Stream, "implicit_int_import", !IO)
;
ImplicitImportAndOrUse = implicit_int_use,
io.write_string(Stream, "implicit_int_use", !IO)
;
ImplicitImportAndOrUse = implicit_imp_use,
io.write_string(Stream, "implicit_imp_use", !IO)
)
),
io.nl(Stream, !IO).
%---------------------------------------------------------------------------%
mercury_output_ancestor_int_spec(Info, Stream, AncestorIntSpec, !IO) :-
AncestorIntSpec = ancestor_int0(ParseTreeInt0, _),
mercury_output_parse_tree_int0(Info, Stream, ParseTreeInt0, !IO).
mercury_output_direct_int1_spec(Info, Stream, DirectInt1Spec, !IO) :-
DirectInt1Spec = direct_int1(ParseTreeInt1, _),
mercury_output_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO).
mercury_output_direct_int3_spec(Info, Stream, DirectInt3Spec, !IO) :-
DirectInt3Spec = direct_int3(ParseTreeInt3, _),
mercury_output_parse_tree_int3(Info, Stream, ParseTreeInt3, !IO).
mercury_output_indirect_int2_spec(Info, Stream, IndirectInt2Spec, !IO) :-
IndirectInt2Spec = indirect_int2(ParseTreeInt2, _),
mercury_output_parse_tree_int2(Info, Stream, ParseTreeInt2, !IO).
mercury_output_indirect_int3_spec(Info, Stream, IndirectInt3Spec, !IO) :-
IndirectInt3Spec = indirect_int3(ParseTreeInt3, _),
mercury_output_parse_tree_int3(Info, Stream, ParseTreeInt3, !IO).
mercury_output_int_for_opt_spec(Info, Stream, ForOptIntSpec, !IO) :-
(
ForOptIntSpec = for_opt_int0(ParseTreeInt0, _),
mercury_output_parse_tree_int0(Info, Stream, ParseTreeInt0, !IO)
;
ForOptIntSpec = for_opt_int1(ParseTreeInt1, _),
mercury_output_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO)
;
ForOptIntSpec = for_opt_int2(ParseTreeInt2, _),
mercury_output_parse_tree_int2(Info, Stream, ParseTreeInt2, !IO)
).
mercury_output_type_repn_spec(Info, Stream, TypeRepnSpec, !IO) :-
TypeRepnSpec = type_repn_spec_int1(ParseTreeInt1),
mercury_output_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO).
%---------------------------------------------------------------------------%
mercury_output_parse_tree_int0(Info, Stream, ParseTreeInt0, !IO) :-
ParseTreeInt0 = parse_tree_int0(ModuleName, _ModuleContext,
MaybeVersionNumbers, InclMap,
ImportUseMap, IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntPromises,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpDeclPragmas, ImpPromises),
include_map_to_int_imp_modules(InclMap, IntIncls, ImpIncls),
map.foldl4(get_imports_uses, ImportUseMap,
set.init, IntImports, set.init, ImpImports,
set.init, IntUses, set.init, ImpUses),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, ImpModeDefns),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
mercury_output_maybe_module_version_numbers(Stream, ModuleName,
MaybeVersionNumbers, !IO),
mercury_output_section_marker(Stream, ms_interface, !IO),
set.foldl(mercury_output_module_decl(Stream, "include_module"),
IntIncls, !IO),
set.foldl(mercury_output_module_decl(Stream, "import_module"),
IntImports, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
IntUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), IntFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
IntTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
IntInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
IntModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(IntTypeClasses), !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
list.sort(IntInstances), !IO),
order_pred_and_mode_decls(IntPredDecls, IntModeDecls, IntPredOrModeDecls),
mercury_output_pred_or_mode_decls(Info, print_name_only, Stream,
IntPredOrModeDecls, !IO),
list.foldl(mercury_output_item_decl_pragma(Info, Stream),
list.sort(IntDeclPragmas), !IO),
list.foldl(mercury_output_item_promise(Info, Stream),
list.sort(IntPromises), !IO),
( if
set.is_empty(ImpIncls),
set.is_empty(ImpImports),
set.is_empty(ImpUses),
set.is_empty(ImpFIMSpecs),
ImpTypeDefns = [],
ImpInstDefns = [],
ImpModeDefns = [],
ImpTypeClasses = [],
ImpInstances = [],
ImpPredDecls = [],
ImpModeDecls = [],
ImpForeignEnums = [],
ImpDeclPragmas = [],
ImpPromises = []
then
true
else
mercury_output_section_marker(Stream, ms_implementation, !IO),
set.foldl(mercury_output_module_decl(Stream, "include_module"),
ImpIncls, !IO),
set.foldl(mercury_output_module_decl(Stream, "import_module"),
ImpImports, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
ImpUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), ImpFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
ImpTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
ImpInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
ImpModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(ImpTypeClasses), !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
list.sort(ImpInstances), !IO),
order_pred_and_mode_decls(ImpPredDecls, ImpModeDecls,
ImpPredOrModeDecls),
mercury_output_pred_or_mode_decls(Info, print_name_only, Stream,
ImpPredOrModeDecls, !IO),
list.foldl(mercury_format_item_foreign_enum(Info, Stream),
ImpForeignEnums, !IO),
list.foldl(mercury_output_item_decl_pragma(Info, Stream),
list.sort(ImpDeclPragmas), !IO),
list.foldl(mercury_output_item_promise(Info, Stream),
list.sort(ImpPromises), !IO)
).
mercury_output_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO) :-
ParseTreeInt1 = parse_tree_int1(ModuleName, _ModuleContext,
MaybeVersionNumbers, InclMap, UseMap, IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntPromises, IntTypeRepnMap,
ImpTypeClasses),
include_map_to_int_imp_modules(InclMap, IntIncls, ImpIncls),
map.foldl2(get_uses, UseMap, set.init, IntUses, set.init, ImpUses),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, _ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, _ImpModeDefns),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
mercury_output_maybe_module_version_numbers(Stream, ModuleName,
MaybeVersionNumbers, !IO),
mercury_output_section_marker(Stream, ms_interface, !IO),
set.foldl(mercury_output_module_decl(Stream, "include_module"),
IntIncls, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
IntUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), IntFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
IntTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
IntInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
IntModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(IntTypeClasses), !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
list.sort(IntInstances), !IO),
order_pred_and_mode_decls(IntPredDecls, IntModeDecls, IntPredOrModeDecls),
mercury_output_pred_or_mode_decls(Info, print_name_only, Stream,
IntPredOrModeDecls, !IO),
list.foldl(mercury_output_item_decl_pragma(Info, Stream),
list.sort(IntDeclPragmas), !IO),
list.foldl(mercury_output_item_promise(Info, Stream),
list.sort(IntPromises), !IO),
map.foldl_values(mercury_output_item_type_repn(Info, Stream),
IntTypeRepnMap, !IO),
( if
set.is_empty(ImpIncls),
set.is_empty(ImpUses),
set.is_empty(ImpFIMSpecs),
ImpTypeDefns = [],
ImpForeignEnums = [],
ImpTypeClasses = []
then
true
else
mercury_output_section_marker(Stream, ms_implementation, !IO),
set.foldl(mercury_output_module_decl(Stream, "include_module"),
ImpIncls, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
ImpUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), ImpFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
ImpTypeDefns, !IO),
list.foldl(mercury_format_item_foreign_enum(Info, Stream),
ImpForeignEnums, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(ImpTypeClasses), !IO)
).
mercury_output_parse_tree_int2(Info, Stream, ParseTreeInt2, !IO) :-
ParseTreeInt2 = parse_tree_int2(ModuleName, _ModuleContext,
MaybeVersionNumbers, IntInclMap, UseMap, IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntTypeRepnMap),
InclMap = coerce(IntInclMap),
include_map_to_int_imp_modules(InclMap, IntIncls, _ImpIncls),
map.foldl2(get_uses, UseMap, set.init, IntUses, set.init, ImpUses),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, _ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, _ImpModeDefns),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
mercury_output_maybe_module_version_numbers(Stream, ModuleName,
MaybeVersionNumbers, !IO),
mercury_output_section_marker(Stream, ms_interface, !IO),
set.foldl(mercury_output_module_decl(Stream, "include_module"),
IntIncls, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
IntUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), IntFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
IntTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream),
IntInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream),
IntModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(IntTypeClasses), !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
list.sort(IntInstances), !IO),
map.foldl_values(mercury_output_item_type_repn(Info, Stream),
IntTypeRepnMap, !IO),
% XXX Currently, ImpUses will always be empty, but the fix for
% Mantis bug #563 will require allowing ImpUses to be nonempty.
( if
set.is_empty(ImpFIMSpecs),
set.is_empty(ImpUses),
ImpTypeDefns = []
then
true
else
mercury_output_section_marker(Stream, ms_implementation, !IO),
set.foldl(mercury_output_module_decl(Stream, "use_module"),
ImpUses, !IO),
set.foldl(mercury_output_fim_spec(Stream), ImpFIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream),
ImpTypeDefns, !IO)
).
mercury_output_parse_tree_int3(Info, Stream, ParseTreeInt3, !IO) :-
ParseTreeInt3 = parse_tree_int3(ModuleName, _ModuleContext,
IntInclMap, IntImportMap,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntTypeRepnMap),
type_ctor_checked_map_get_src_defns(TypeCtorCheckedMap,
IntTypeDefns, _ImpTypeDefns, _ImpForeignEnums),
inst_ctor_checked_map_get_src_defns(InstCtorCheckedMap,
IntInstDefns, _ImpInstDefns),
mode_ctor_checked_map_get_src_defns(ModeCtorCheckedMap,
IntModeDefns, _ImpModeDefns),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
mercury_output_section_marker(Stream, ms_interface, !IO),
IntInclMap = int_incl_context_map(IntInclMap0),
list.foldl(mercury_output_module_decl(Stream, "include_module"),
map.sorted_keys(IntInclMap0), !IO),
IntImportMap = int_import_context_map(IntImportMap0),
list.foldl(mercury_output_module_decl(Stream, "import_module"),
map.sorted_keys(IntImportMap0), !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream), IntTypeDefns, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream), IntInstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream), IntModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream),
list.sort(IntTypeClasses), !IO),
list.foldl(mercury_output_item_instance(Info, Stream),
list.sort(IntInstances), !IO),
map.foldl_values(mercury_output_item_type_repn(Info, Stream),
IntTypeRepnMap, !IO).
%---------------------------------------------------------------------------%
mercury_output_parse_tree_plain_opt(Info, Stream, ParseTree, !IO) :-
ParseTree = parse_tree_plain_opt(ModuleName, _Context,
UseMap, FIMSpecs, TypeDefns, ForeignEnums,
InstDefns, ModeDefns, TypeClasses, Instances,
PredDecls, ModeDecls, Clauses, ForeignProcs, Promises,
PredMarkers, TypeSpecs, UnusedArgs, Terms, Term2s,
Exceptions, Trailings, MMTablings, Sharings, Reuses),
Lang = get_output_lang(Info),
io.write_string(Stream, "% .opt file\n", !IO),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
list.foldl(mercury_output_module_decl(Stream, "use_module"),
map.keys(UseMap), !IO),
set.foldl(mercury_output_fim_spec(Stream), FIMSpecs, !IO),
list.foldl(mercury_output_item_type_defn(Info, Stream), TypeDefns, !IO),
list.foldl(mercury_format_item_foreign_enum(Info, Stream),
ForeignEnums, !IO),
list.foldl(mercury_output_item_inst_defn(Info, Stream), InstDefns, !IO),
list.foldl(mercury_output_item_mode_defn(Info, Stream), ModeDefns, !IO),
list.foldl(mercury_output_item_typeclass(Info, Stream), TypeClasses, !IO),
list.foldl(mercury_output_item_instance(Info, Stream), Instances, !IO),
% NOTE: The names of type variables in type_spec pragmas must match
% *exactly* the names of the corresponding type variables in the
% predicate declaration to which they apply. This is why one variable,
% VarNamePrint, controls both.
%
% If a predicate is defined by a foreign_proc, then its declaration
% *must* be printed with print_name_only, because that is the only way
% that any reference to the type_info variable in the foreign code
% in the body of the foreign_proc will match the declared name of the
% type variable that it is for.
%
% We used to print the predicate declarations with print_name_only
% for such predicates (predicates defined by foreign_procs) and with
% print_name_and_num for all other predicates. (That included predicates
% representing promises.) However, the predicates whose declarations
% we are writing out have not been through any transformation that
% would have either (a) changed the names of any existing type variables,
% or (b) introduced any new type variables, so the mapping between
% type variable numbers and names should be the same now as when the
% the predicate declaration was first parsed. And at that time, two
% type variable occurrences with the same name obviously referred to the
% same type variable, so the numeric suffix added by print_name_and_num
% was obviously not needed.
VarNamePrintPredDecl = print_name_only,
list.foldl(
mercury_output_item_pred_decl(Lang, VarNamePrintPredDecl, Stream),
PredDecls, !IO),
list.foldl(mercury_output_item_mode_decl(Info, Stream), ModeDecls, !IO),
list.foldl(mercury_output_item_pred_marker(Stream),
list.map(project_pragma_type, PredMarkers), !IO),
list.foldl(
mercury_output_pragma_type_spec(Stream, Lang),
list.map(project_pragma_type, TypeSpecs), !IO),
list.foldl(mercury_output_item_clause(Info, Stream), Clauses, !IO),
list.foldl(mercury_output_pragma_foreign_proc(Stream, Lang),
list.map(project_pragma_type, ForeignProcs), !IO),
list.foldl(mercury_output_item_promise(Info, Stream), Promises, !IO),
maybe_write_block_start_blank_line(Stream, UnusedArgs, !IO),
list.foldl(mercury_output_pragma_unused_args(Stream),
list.map(project_pragma_type, UnusedArgs), !IO),
maybe_write_block_start_blank_line(Stream, Terms, !IO),
list.foldl(write_pragma_termination_info(Stream, Lang),
list.map(project_pragma_type, Terms), !IO),
maybe_write_block_start_blank_line(Stream, Term2s, !IO),
list.foldl(write_pragma_termination2_info(Stream, Lang),
list.map(project_pragma_type, Term2s), !IO),
maybe_write_block_start_blank_line(Stream, Exceptions, !IO),
list.foldl(mercury_output_pragma_exceptions(Stream),
list.map(project_pragma_type, Exceptions), !IO),
maybe_write_block_start_blank_line(Stream, Trailings, !IO),
list.foldl(mercury_output_pragma_trailing_info(Stream),
list.map(project_pragma_type, Trailings), !IO),
maybe_write_block_start_blank_line(Stream, MMTablings, !IO),
list.foldl(mercury_output_pragma_mm_tabling_info(Stream),
list.map(project_pragma_type, MMTablings), !IO),
maybe_write_block_start_blank_line(Stream, Sharings, !IO),
list.foldl(write_pragma_structure_sharing_info(Stream, Lang),
list.map(project_pragma_type, Sharings), !IO),
maybe_write_block_start_blank_line(Stream, Reuses, !IO),
list.foldl(write_pragma_structure_reuse_info(Stream, Lang),
list.map(project_pragma_type, Reuses), !IO).
mercury_output_parse_tree_trans_opt(Info, Stream, ParseTree, !IO) :-
ParseTree = parse_tree_trans_opt(ModuleName, _Context,
Terms, Term2s, Exceptions, Trailings, MMTablings, Sharings, Reuses),
Lang = get_output_lang(Info),
io.write_string(Stream, "% .trans_opt file\n", !IO),
mercury_output_module_decl(Stream, "module", ModuleName, !IO),
maybe_write_block_start_blank_line(Stream, Terms, !IO),
list.foldl(write_pragma_termination_info(Stream, Lang),
list.map(project_pragma_type, Terms), !IO),
maybe_write_block_start_blank_line(Stream, Term2s, !IO),
list.foldl(write_pragma_termination2_info(Stream, Lang),
list.map(project_pragma_type, Term2s), !IO),
maybe_write_block_start_blank_line(Stream, Exceptions, !IO),
list.foldl(mercury_output_pragma_exceptions(Stream),
list.map(project_pragma_type, Exceptions), !IO),
maybe_write_block_start_blank_line(Stream, Trailings, !IO),
list.foldl(mercury_output_pragma_trailing_info(Stream),
list.map(project_pragma_type, Trailings), !IO),
maybe_write_block_start_blank_line(Stream, MMTablings, !IO),
list.foldl(mercury_output_pragma_mm_tabling_info(Stream),
list.map(project_pragma_type, MMTablings), !IO),
maybe_write_block_start_blank_line(Stream, Sharings, !IO),
list.foldl(write_pragma_structure_sharing_info(Stream, Lang),
list.map(project_pragma_type, Sharings), !IO),
maybe_write_block_start_blank_line(Stream, Reuses, !IO),
list.foldl(write_pragma_structure_reuse_info(Stream, Lang),
list.map(project_pragma_type, Reuses), !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_maybe_module_version_numbers(io.text_output_stream::in,
module_name::in, maybe_version_numbers::in, io::di, io::uo) is det.
mercury_output_maybe_module_version_numbers(Stream, ModuleName,
MaybeVersionNumbers, !IO) :-
(
MaybeVersionNumbers = no_version_numbers
;
MaybeVersionNumbers = version_numbers(VersionNumbers),
mercury_output_module_version_numbers(Stream, ModuleName,
VersionNumbers, !IO)
).
:- pred mercury_output_module_version_numbers(io.text_output_stream::in,
module_name::in, module_item_version_numbers::in, io::di, io::uo) is det.
mercury_output_module_version_numbers(Stream, ModuleName,
ModuleItemVersionNumbers, !IO) :-
io.format(Stream, ":- version_numbers(%d, %s,\n%s).\n",
[i(module_item_version_numbers_version_number),
s(mercury_bracketed_sym_name_to_string(ModuleName)),
s(module_item_version_numbers_to_string(ModuleItemVersionNumbers))],
!IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_module_components(merc_out_info::in,
io.text_output_stream::in, maybe(module_section)::in,
list(module_component)::in, io::di, io::uo) is det.
mercury_output_module_components(_, _, _, [], !IO).
mercury_output_module_components(Info, Stream, MaybePrevSectionKind,
[Component | Components], !IO) :-
(
Component = mc_section(_, SectionKind, _SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord),
mercury_output_section_marker(Stream, SectionKind, !IO),
list.foldl(mercury_output_item_include(Info, Stream),
cord.list(InclsCord), !IO),
list.foldl(mercury_output_item_avail(Info, Stream),
cord.list(AvailsCord), !IO),
list.foldl(mercury_output_item_foreign_import_module(Stream),
cord.list(FIMsCord), !IO),
mercury_output_items(Info, Stream, cord.list(ItemsCord), !IO),
MaybeCurSectionKind = yes(SectionKind)
;
Component = mc_nested_submodule(_, SectionKind, _, SubParseTree),
Lang = get_output_lang(Info),
(
Lang = output_mercury,
( if
MaybePrevSectionKind = yes(PrevSectionKind),
PrevSectionKind = SectionKind
then
true
else
mercury_output_section_marker(Stream, SectionKind, !IO)
)
;
Lang = output_debug,
mercury_output_section_marker(Stream, SectionKind, !IO),
(
SectionKind = ms_interface,
io.write_string(Stream,
"% nested submodule in interface\n", !IO)
;
SectionKind = ms_implementation,
io.write_string(Stream,
"% nested submodule in implementation\n", !IO)
)
),
mercury_output_parse_tree_src(Info, Stream, SubParseTree, !IO),
MaybeCurSectionKind = MaybePrevSectionKind
),
mercury_output_module_components(Info, Stream, MaybeCurSectionKind,
Components, !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_section_marker(io.text_output_stream::in,
module_section::in, io::di, io::uo) is det.
mercury_output_section_marker(Stream, Section, !IO) :-
(
Section = ms_interface,
io.write_string(Stream, ":- interface.\n", !IO)
;
Section = ms_implementation,
io.write_string(Stream, ":- implementation.\n", !IO)
).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_include(merc_out_info::in,
io.text_output_stream::in, item_include::in, io::di, io::uo) is det.
mercury_output_item_include(Info, Stream, ItemInclude, !IO) :-
ItemInclude = item_include(ModuleName, Context, _SeqNum),
Decl = "include_module",
maybe_output_line_number(Info, Context, Stream, !IO),
mercury_output_module_decl(Stream, Decl, ModuleName, !IO).
:- pred mercury_output_item_avail(merc_out_info::in,
io.text_output_stream::in, item_avail::in, io::di, io::uo) is det.
mercury_output_item_avail(Info, Stream, Avail, !IO) :-
(
Avail = avail_import(avail_import_info(ModuleName, Context, _SeqNum)),
Decl = "import_module"
;
Avail = avail_use(avail_use_info(ModuleName, Context, _SeqNum)),
Decl = "use_module"
),
maybe_output_line_number(Info, Context, Stream, !IO),
mercury_output_module_decl(Stream, Decl, ModuleName, !IO).
mercury_output_module_decl(Stream, Decl, ModuleName, !IO) :-
ModuleNameStr = mercury_bracketed_sym_name_to_string(ModuleName),
io.format(Stream, ":- %s %s.\n", [s(Decl), s(ModuleNameStr)], !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_items(merc_out_info::in, io.text_output_stream::in,
list(item)::in, io::di, io::uo) is det.
mercury_output_items(_, _, [], !IO).
mercury_output_items(Info, Stream, [Item | Items], !IO) :-
mercury_output_item(Info, Stream, Item, !IO),
mercury_output_items(Info, Stream, Items, !IO).
mercury_output_item(Info, Stream, Item, !IO) :-
(
Item = item_clause(ItemClause),
mercury_output_item_clause(Info, Stream, ItemClause, !IO)
;
Item = item_type_defn(ItemTypeDefn),
mercury_output_item_type_defn(Info, Stream, ItemTypeDefn, !IO)
;
Item = item_inst_defn(ItemInstDefn),
mercury_output_item_inst_defn(Info, Stream, ItemInstDefn, !IO)
;
Item = item_mode_defn(ItemModeDefn),
mercury_output_item_mode_defn(Info, Stream, ItemModeDefn, !IO)
;
Item = item_pred_decl(ItemPredDecl),
mercury_output_item_pred_decl_mu_mc(Info, print_name_only, Stream,
ItemPredDecl, !IO)
;
Item = item_mode_decl(ItemModeDecl),
mercury_output_item_mode_decl(Info, Stream, ItemModeDecl, !IO)
;
Item = item_foreign_enum(ItemForeignEnum),
mercury_format_item_foreign_enum(Info, Stream, ItemForeignEnum, !IO)
;
Item = item_foreign_export_enum(ItemForeignExportEnum),
mercury_format_item_foreign_export_enum(Info, ItemForeignExportEnum,
Stream, !IO)
;
Item = item_decl_pragma(ItemDeclPragma),
mercury_output_item_decl_pragma(Info, Stream, ItemDeclPragma, !IO)
;
Item = item_impl_pragma(ItemImplPragma),
mercury_output_item_impl_pragma(Info, Stream, ItemImplPragma, !IO)
;
Item = item_generated_pragma(ItemGenPragma),
mercury_output_item_generated_pragma(Info, Stream, ItemGenPragma, !IO)
;
Item = item_promise(ItemPromise),
mercury_output_item_promise(Info, Stream, ItemPromise, !IO)
;
Item = item_typeclass(ItemTypeClass),
mercury_output_item_typeclass(Info, Stream, ItemTypeClass, !IO)
;
Item = item_instance(ItemInstance),
mercury_output_item_instance(Info, Stream, ItemInstance, !IO)
;
Item = item_initialise(ItemInitialise),
mercury_output_item_initialise(Info, Stream, ItemInitialise, !IO)
;
Item = item_finalise(ItemFinalise),
mercury_output_item_finalise(Info, Stream, ItemFinalise, !IO)
;
Item = item_mutable(ItemMutable),
mercury_output_item_mutable(Info, Stream, ItemMutable, !IO)
;
Item = item_type_repn(ItemTypeRepn),
mercury_output_item_type_repn(Info, Stream, ItemTypeRepn, !IO)
).
%---------------------------------------------------------------------------%
:- pred mercury_output_pred_or_mode_decls(merc_out_info::in,
var_name_print::in, io.text_output_stream::in,
list(pred_or_mode_decl_item)::in, io::di, io::uo) is det.
mercury_output_pred_or_mode_decls(_, _, _, [], !IO).
mercury_output_pred_or_mode_decls(Info, VarNamePrint, Stream,
[Item | Items], !IO) :-
mercury_output_pred_or_mode_decl(Info, VarNamePrint, Stream, Item, !IO),
mercury_output_pred_or_mode_decls(Info, VarNamePrint, Stream, Items, !IO).
:- pred mercury_output_pred_or_mode_decl(merc_out_info::in, var_name_print::in,
io.text_output_stream::in, pred_or_mode_decl_item::in,
io::di, io::uo) is det.
mercury_output_pred_or_mode_decl(Info, VarNamePrint, Stream, Item, !IO) :-
(
Item = pomd_pred(ItemPredDecl),
mercury_output_item_pred_decl_mu_mc(Info, VarNamePrint, Stream,
ItemPredDecl, !IO)
;
Item = pomd_mode(ItemModeDecl),
mercury_output_item_mode_decl(Info, Stream, ItemModeDecl, !IO)
).
%---------------------------------------------------------------------------%
mercury_output_item_type_defn(Info, Stream, ItemTypeDefn, !IO) :-
% XXX We should not use the tvar names in TypeVarSet; we should be
% using standard tvar names such as TV1, TV2 etc. This should allow
% any automatically generated interface files to remain unchanged
% when the names of the type variables change in the source code,
% thus avoiding the cascade of module recompilations that would
% otherwise result.
ItemTypeDefn = item_type_defn_info(SymName0, TypeParams, TypeDefn,
TypeVarSet, Context, _SeqNum),
maybe_unqualify_sym_name(Info, SymName0, SymName),
maybe_output_line_number(Info, Context, Stream, !IO),
Args = list.map((func(V) = term.variable(V, Context)), TypeParams),
construct_qualified_term_with_context(SymName, Args, Context, TypeTerm),
(
TypeDefn = parse_tree_abstract_type(DetailsAbstract),
(
( DetailsAbstract = abstract_type_general
; DetailsAbstract = abstract_dummy_type
; DetailsAbstract = abstract_notag_type
; DetailsAbstract = abstract_type_fits_in_n_bits(_)
; DetailsAbstract = abstract_subtype(_)
),
io.write_string(Stream, ":- type ", !IO)
;
DetailsAbstract = abstract_solver_type,
io.write_string(Stream, ":- solver type ", !IO)
),
mercury_output_term_nq_vs(TypeVarSet, print_name_only,
next_to_graphic_token, TypeTerm, Stream, !IO),
(
DetailsAbstract = abstract_type_fits_in_n_bits(NumBits),
% XXX TYPE_REPN Instead of adding this information to the
% generated type definition, generate and write out
% a separate type_repn item instead.
mercury_output_where_abstract_enum_type(Stream, NumBits, !IO)
;
( DetailsAbstract = abstract_dummy_type
; DetailsAbstract = abstract_notag_type
)
% XXX TYPE_REPN The same concern applies here, but these
% kinds of abstract types are not yet generated anywhere,
% so we don't have anything to do for them.
;
DetailsAbstract = abstract_subtype(SuperTypeCtor),
mercury_output_where_abstract_subtype(Stream, SuperTypeCtor, !IO)
;
( DetailsAbstract = abstract_type_general
; DetailsAbstract = abstract_solver_type
)
),
io.write_string(Stream, ".\n", !IO)
;
TypeDefn = parse_tree_eqv_type(DetailsEqv),
DetailsEqv = type_details_eqv(EqvType),
io.write_string(Stream, ":- type ", !IO),
mercury_output_term_vs(TypeVarSet, print_name_only, TypeTerm,
Stream, !IO),
io.write_string(Stream, " == ", !IO),
mercury_output_type(TypeVarSet, print_name_only, EqvType, Stream, !IO),
io.write_string(Stream, ".\n", !IO)
;
TypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(OoMCtors, MaybeCanonical, MaybeDirectArgs),
io.write_string(Stream, ":- type ", !IO),
mercury_output_term_vs(TypeVarSet, print_name_only, TypeTerm,
Stream, !IO),
OoMCtors = one_or_more(HeadCtor, TailCtors),
mercury_output_ctors(TypeVarSet, yes, HeadCtor, TailCtors,
Stream, !IO),
mercury_output_where_attributes(Info, TypeVarSet, no,
MaybeCanonical, MaybeDirectArgs, Stream, !IO),
io.write_string(Stream, ".\n", !IO)
;
TypeDefn = parse_tree_sub_type(DetailsDu),
DetailsDu = type_details_sub(SuperType, OoMCtors),
io.write_string(Stream, ":- type ", !IO),
mercury_output_term_vs(TypeVarSet, print_name_only, TypeTerm,
Stream, !IO),
io.write_string(Stream, " =< ", !IO),
mercury_output_type(TypeVarSet, print_name_only, SuperType,
Stream, !IO),
OoMCtors = one_or_more(HeadCtor, TailCtors),
mercury_output_ctors(TypeVarSet, yes, HeadCtor, TailCtors,
Stream, !IO),
io.write_string(Stream, ".\n", !IO)
;
TypeDefn = parse_tree_solver_type(DetailsSolver),
DetailsSolver =
type_details_solver(SolverTypeDetails, MaybeCanonical),
io.write_string(Stream, ":- solver type ", !IO),
mercury_output_term_vs(TypeVarSet, print_name_only, TypeTerm,
Stream, !IO),
mercury_output_where_attributes(Info, TypeVarSet,
yes(SolverTypeDetails), MaybeCanonical, no, Stream, !IO),
io.write_string(Stream, ".\n", !IO)
;
TypeDefn = parse_tree_foreign_type(DetailsForeign),
DetailsForeign = type_details_foreign(ForeignType, MaybeCanonical,
foreign_type_assertions(Assertions)),
io.write_string(Stream, ":- pragma foreign_type(", !IO),
(
ForeignType = c(_),
io.write_string(Stream, "c, ", !IO)
;
ForeignType = java(_),
io.write_string(Stream, "java, ", !IO)
;
ForeignType = csharp(_),
io.write_string(Stream, "csharp, ", !IO)
),
mercury_output_term_vs(TypeVarSet, print_name_only, TypeTerm,
Stream, !IO),
io.write_string(Stream, ", \"", !IO),
(
ForeignType = c(c_type(ForeignTypeStr))
;
ForeignType = java(java_type(ForeignTypeStr))
;
ForeignType = csharp(csharp_type(ForeignTypeStr))
),
io.write_string(Stream, ForeignTypeStr, !IO),
io.write_string(Stream, "\"", !IO),
set.to_sorted_list(Assertions, AssertionsList),
(
AssertionsList = []
;
AssertionsList = [_ | _],
AssertionStrs =
list.map(foreign_type_assertion_to_string, AssertionsList),
AssertionsStr = string.join_list(", ", AssertionStrs),
io.write_string(Stream, ", [", !IO),
io.write_string(Stream, AssertionsStr, !IO),
io.write_string(Stream, "]", !IO)
),
io.write_string(Stream, ")", !IO),
mercury_output_where_attributes(Info, TypeVarSet, no,
MaybeCanonical, no, Stream, !IO),
io.write_string(Stream, ".\n", !IO)
).
%---------------------%
%
% Predicates needed to output more than one kind of type.
%
mercury_output_where_attributes(Info, TypeVarSet, MaybeSolverTypeDetails,
MaybeCanonical, MaybeDirectArgs, Stream, !IO) :-
some [!LineCord]
(
!:LineCord = cord.init,
(
MaybeCanonical = canon
;
MaybeCanonical = noncanon(NonCanon),
(
NonCanon = noncanon_abstract(_),
cord.snoc("type_is_abstract_noncanonical", !LineCord)
;
NonCanon = noncanon_subtype
;
NonCanon = noncanon_uni_cmp(UniPred, CmpPred),
UniPredStr = mercury_bracketed_sym_name_to_string(UniPred),
CmpPredStr = mercury_bracketed_sym_name_to_string(CmpPred),
UniPredLine = "equality is " ++ UniPredStr,
CmpPredLine = "comparison is " ++ CmpPredStr,
cord.snoc(UniPredLine, !LineCord),
cord.snoc(CmpPredLine, !LineCord)
;
NonCanon = noncanon_uni_only(UniPred),
UniPredStr = mercury_bracketed_sym_name_to_string(UniPred),
UniPredLine = "equality is " ++ UniPredStr,
cord.snoc(UniPredLine, !LineCord)
;
NonCanon = noncanon_cmp_only(CmpPred),
CmpPredStr = mercury_bracketed_sym_name_to_string(CmpPred),
CmpPredLine = "comparison is " ++ CmpPredStr,
cord.snoc(CmpPredLine, !LineCord)
)
),
(
MaybeDirectArgs = yes(DirectArgFunctors),
FunctorStrs =
list.map(mercury_bracketed_sym_name_arity_to_string,
DirectArgFunctors),
FunctorsStr = string.join_list(", ", FunctorStrs),
string.format("direct_arg is [%s]", [s(FunctorsStr)],
DirectArgLine),
cord.snoc(DirectArgLine, !LineCord)
;
MaybeDirectArgs = no
),
Lines = cord.list(!.LineCord),
( if
MaybeSolverTypeDetails = no,
Lines = []
then
true
else
io.write_string(Stream, "\n where\n", !IO),
(
MaybeSolverTypeDetails = yes(SolverTypeDetails),
mercury_output_solver_type_details(Info, Stream, TypeVarSet,
SolverTypeDetails, !IO),
(
Lines = []
;
Lines = [_ | _],
io.write_string(Stream, ",\n", !IO)
)
;
MaybeSolverTypeDetails = no
),
% We cannot curry string.append, because it has several modes.
IndentLine =
( func(Line) = IndentedLine :-
string.append(" ", Line, IndentedLine)
),
IndentedLines = list.map(IndentLine, Lines),
AllLines = string.join_list(",\n", IndentedLines),
io.write_string(Stream, AllLines, !IO)
)
).
:- pred mercury_output_solver_type_details(merc_out_info::in,
io.text_output_stream::in, tvarset::in, solver_type_details::in,
io::di, io::uo) is det.
mercury_output_solver_type_details(Info, Stream, TypeVarSet, Details, !IO) :-
Details = solver_type_details(RepresentationType, GroundInst,
AnyInst, MutableInfos),
io.write_string(Stream, " representation is ", !IO),
mercury_output_type(TypeVarSet, print_name_only, RepresentationType,
Stream, !IO),
Lang = get_output_lang(Info),
varset.init(EmptyInstVarSet),
io.write_string(Stream, ",\n ground is ", !IO),
mercury_output_inst(Stream, Lang, EmptyInstVarSet, GroundInst, !IO),
io.write_string(Stream, ",\n any is ", !IO),
mercury_output_inst(Stream, Lang, EmptyInstVarSet, AnyInst, !IO),
(
MutableInfos = []
;
MutableInfos = [_ | _],
io.write_string(Stream,
",\n constraint_store is [\n ", !IO),
write_out_list(mercury_output_item_mutable_2(Info),
",\n ", MutableInfos, Stream, !IO),
io.write_string(Stream, "\n ]", !IO)
).
%---------------------%
%
% Predicates needed to output abstract types.
%
:- pred mercury_output_where_abstract_enum_type(io.text_output_stream::in,
int::in, io::di, io::uo) is det.
mercury_output_where_abstract_enum_type(Stream, NumBits, !IO) :-
io.write_string(Stream, "\n\twhere\t", !IO),
io.write_string(Stream, "type_is_abstract_enum(", !IO),
% XXX TYPE_REPN
% io.write_string(Stream, "type_is_representable_in_n_bits(", !IO),
io.write_int(Stream, NumBits, !IO),
io.write_string(Stream, ")", !IO).
:- pred mercury_output_where_abstract_subtype(io.text_output_stream::in,
type_ctor::in, io::di, io::uo) is det.
mercury_output_where_abstract_subtype(Stream, TypeCtor, !IO) :-
io.write_string(Stream, "\n\twhere\t", !IO),
io.write_string(Stream, "type_is_abstract_subtype(", !IO),
TypeCtor = type_ctor(SymName, Arity),
mercury_output_sym_name(SymName, Stream, !IO),
io.write_string(Stream, "/", !IO),
io.write_int(Stream, Arity, !IO),
io.write_string(Stream, ")", !IO).
%---------------------%
%
% Predicates needed to output discriminated union types.
%
:- pred mercury_output_ctors(tvarset::in, bool::in,
constructor::in, list(constructor)::in, io.text_output_stream::in,
io::di, io::uo) is det.
mercury_output_ctors(VarSet, First, HeadCtor, TailCtors, Stream, !IO) :-
(
First = yes,
io.write_string(Stream, "\n ---> ", !IO)
;
First = no,
io.write_string(Stream, "\n ; ", !IO)
),
mercury_output_ctor(VarSet, HeadCtor, Stream, !IO),
(
TailCtors = []
;
TailCtors = [HeadTailCtor | TailTailCtors],
mercury_output_ctors(VarSet, no, HeadTailCtor, TailTailCtors,
Stream, !IO)
).
mercury_output_ctor(TVarSet, Ctor, Stream, !IO) :-
% NOTE The code of this predicate is almost identical to the
% code of write_ctor and write_ctor_repn in hlds_out_module.m.
% Any changes made here will probably need to be made there as well.
Ctor = ctor(_Ordinal, MaybeExistConstraints, SymName, Args, Arity, _Ctxt),
% The module name in SymName must be the same as the module qualifier
% of the type_ctor, so there is no point in printing it.
Name = unqualify_name(SymName),
maybe_cons_exist_constraints_to_prefix_suffix(TVarSet, "", "",
MaybeExistConstraints, ExistConstraintsPrefix, ExistConstraintsSuffix),
maybe_brace_for_name_prefix_suffix(Arity, Name, BracePrefix, BraceSuffix),
io.write_string(Stream, ExistConstraintsPrefix, !IO),
io.write_string(Stream, BracePrefix, !IO),
(
Args = [],
mercury_output_bracketed_sym_name(unqualified(Name), Stream, !IO),
% This space prevents a terminating full stop from being confused
% as part of the sym_name if the sym_name contains graphical
% characters.
io.write_string(Stream, " ", !IO)
;
Args = [HeadArg | TailArgs],
mercury_output_sym_name(unqualified(Name), Stream, !IO),
io.write_string(Stream, "(", !IO),
mercury_output_ctor_args(Stream, TVarSet, HeadArg, TailArgs, !IO),
io.write_string(Stream, ")", !IO)
),
io.write_string(Stream, BraceSuffix, !IO),
io.write_string(Stream, ExistConstraintsSuffix, !IO).
maybe_cons_exist_constraints_to_prefix_suffix(TVarSet, SuffixStart, SuffixEnd,
MaybeExistConstraints, Prefix, Suffix) :-
(
MaybeExistConstraints = no_exist_constraints,
Prefix = "",
Suffix = ""
;
MaybeExistConstraints = exist_constraints(ExistConstraints),
ExistConstraints = cons_exist_constraints(ExistQVars, Constraints,
_UnconstrainedQVars, _ConstrainedQVars),
ExistQVarsStr = mercury_quantifier_to_string(TVarSet,
print_name_only, ExistQVars),
ConstraintsStr = mercury_prog_constraint_list_to_string(TVarSet,
print_name_only, "=>", Constraints),
Prefix = ExistQVarsStr ++ "(",
Suffix = SuffixStart ++ ConstraintsStr ++ ")" ++ SuffixEnd
).
maybe_brace_for_name_prefix_suffix(Arity, Name, Prefix, Suffix) :-
% We need to quote ';'/2, '{}'/2, '=>'/2, and 'some'/2.
% XXX I (zs) think that we should not allow these as constructor names.
( if
Arity = 2,
( Name = ";"
; Name = "{}"
; Name = "some"
; Name = "=>"
)
then
Prefix = "{ ",
Suffix = " }"
else
Prefix = "",
Suffix = ""
).
:- pred mercury_output_ctor_args(io.text_output_stream::in, tvarset::in,
constructor_arg::in, list(constructor_arg)::in, io::di, io::uo) is det.
mercury_output_ctor_args(Stream, TVarSet, HeadArg, TailArgs, !IO) :-
mercury_output_ctor_arg(Stream, TVarSet, HeadArg, !IO),
(
TailArgs = []
;
TailArgs = [HeadTailArg | TailTailArgs],
io.write_string(Stream, ", ", !IO),
mercury_output_ctor_args(Stream, TVarSet,
HeadTailArg, TailTailArgs, !IO)
).
:- pred mercury_output_ctor_arg(io.text_output_stream::in, tvarset::in,
constructor_arg::in, io::di, io::uo) is det.
mercury_output_ctor_arg(Stream, TVarSet, Arg, !IO) :-
Arg = ctor_arg(Name, Type, _Context),
mercury_output_ctor_arg_name_prefix(Stream, Name, !IO),
mercury_output_type(TVarSet, print_name_only, Type, Stream, !IO).
:- pred mercury_output_ctor_arg_name_prefix(io.text_output_stream::in,
maybe(ctor_field_name)::in, io::di, io::uo) is det.
mercury_output_ctor_arg_name_prefix(_Stream, no, !IO).
mercury_output_ctor_arg_name_prefix(Stream, yes(FieldName), !IO) :-
FieldName = ctor_field_name(Name, _Ctxt),
mercury_output_bracketed_sym_name(Name, Stream, !IO),
io.write_string(Stream, " :: ", !IO).
%---------------------------------------------------------------------------%
mercury_output_item_inst_defn(Info, Stream, ItemInstDefn, !IO) :-
ItemInstDefn = item_inst_defn_info(SymName0, InstParams, MaybeForTypeCtor,
MaybeAbstractInstDefn, InstVarSet, Context, _SeqNum),
% If the unqualified name is a builtin inst, then output the qualified
% name. This prevents the compiler giving an error about redefining
% builtin insts when an interface file is read back in.
maybe_unqualify_sym_name(Info, SymName0, UnQualSymName),
( if is_builtin_inst_name(InstVarSet, UnQualSymName, InstParams) then
SymName = SymName0
else
SymName = UnQualSymName
),
maybe_output_line_number(Info, Context, Stream, !IO),
Lang = get_output_lang(Info),
ArgTerms = list.map(func(V) = variable(V, Context), InstParams),
construct_qualified_term_with_context(SymName, ArgTerms, Context,
InstTerm),
(
MaybeAbstractInstDefn = abstract_inst_defn,
io.write_string(Stream, ":- abstract_inst((", !IO),
mercury_output_term_vs(InstVarSet, print_name_only, InstTerm,
Stream, !IO),
io.write_string(Stream, ")).\n", !IO)
;
MaybeAbstractInstDefn = nonabstract_inst_defn(eqv_inst(Inst)),
( if
% Is it safe to print the inst name without parentheses around it?
sym_name_is_simple(SymName),
not (
SymName = unqualified(Name),
mercury_op(Name)
)
then
% Yes it is, so print the inst and its parameters without
% extra parentheses around them.
io.format(Stream, ":- inst %s",
[s(sym_name_to_string(SymName))], !IO),
(
ArgTerms = []
;
ArgTerms = [HeadArgTerm | TailArgTerms],
io.write_string(Stream, "(", !IO),
mercury_format_comma_separated_terms_vs(InstVarSet,
print_name_only, HeadArgTerm, TailArgTerms, Stream, !IO),
io.write_string(Stream, ")", !IO)
)
else
% No it isn't, so print the extra parentheses.
io.write_string(Stream, ":- inst (", !IO),
mercury_output_term_vs(InstVarSet, print_name_only, InstTerm,
Stream, !IO),
io.write_string(Stream, ")", !IO)
),
(
MaybeForTypeCtor = no
;
MaybeForTypeCtor = yes(ForTypeCtor),
ForTypeCtor = type_ctor(ForTypeCtorSymName, ForTypeCtorArity),
io.write_string(Stream, " for ", !IO),
mercury_output_sym_name(ForTypeCtorSymName, Stream, !IO),
io.write_string(Stream, "/", !IO),
io.write_int(Stream, ForTypeCtorArity, !IO)
),
( if
% Can we print the inst using the syntax that resembles
% type definitions?
Inst = bound(Uniq, _, BoundInsts),
Uniq = shared,
bound_inst_cons_ids_are_all_simple(BoundInsts, SimpleBIs),
SimpleBIs = [HeadSimpleBI | TailSimpleBIs]
then
% Yes, so use that syntax, which is more readable, partly
% because it has less clutter, and partly because it can be
% formatted to have meaningful indentation.
io.write_string(Stream, "\n", !IO),
output_bound_inst_being_defined(Stream, Lang, InstVarSet,
" ---> ", HeadSimpleBI, TailSimpleBIs, !IO)
else
% No, so fall back to the less readable but more general syntax.
io.write_string(Stream, " == ", !IO),
mercury_output_inst(Stream, Lang, InstVarSet, Inst, !IO),
io.write_string(Stream, ".\n", !IO)
)
).
% Succeed if the sym_name describes a builtin inst.
%
:- pred is_builtin_inst_name(inst_varset::in, sym_name::in, list(inst_var)::in)
is semidet.
is_builtin_inst_name(InstVarSet, unqualified(Name), Args0) :-
Args1 = list.map(func(V) = variable(coerce_var(V), dummy_context), Args0),
Term = term.functor(term.atom(Name), Args1, dummy_context),
varset.coerce(InstVarSet, VarSet),
ContextPieces = cord.init, % Dummy; not used.
parse_inst(no_allow_constrained_inst_var(wnciv_inst_defn_lhs), VarSet,
ContextPieces, Term, MaybeInst),
MaybeInst = ok1(Inst),
Inst \= defined_inst(user_inst(_, _)).
:- type simple_bound_inst
---> simple_bound_functor(string, list(mer_inst)).
:- pred bound_inst_cons_ids_are_all_simple(list(bound_inst)::in,
list(simple_bound_inst)::out) is semidet.
bound_inst_cons_ids_are_all_simple([], []).
bound_inst_cons_ids_are_all_simple([HeadBI | TailBIs],
[HeadSimpleBI | TailSimpleBIs]) :-
HeadBI = bound_functor(ConsId, ArgInsts),
ConsId = cons(SymName, _, _),
sym_name_is_simple(SymName),
SimpleName = sym_name_to_string(SymName),
HeadSimpleBI = simple_bound_functor(SimpleName, ArgInsts),
bound_inst_cons_ids_are_all_simple(TailBIs, TailSimpleBIs).
:- pred sym_name_is_simple(sym_name::in) is semidet.
sym_name_is_simple(SymName) :-
Names = sym_name_to_list(SymName),
all_true(name_is_simple, Names).
:- pred name_is_simple(string::in) is semidet.
name_is_simple(Name) :-
string.to_char_list(Name, Chars),
Chars = [HeadChar | TailChars],
char.is_lower(HeadChar),
all_true(char.is_alnum_or_underscore, TailChars).
:- pred output_bound_inst_being_defined(io.text_output_stream::in,
output_lang::in, inst_varset::in, string::in,
simple_bound_inst::in, list(simple_bound_inst)::in, io::di, io::uo) is det.
output_bound_inst_being_defined(Stream, Lang, InstVarSet, ArrowOrSemi,
HeadBI, TailBIs, !IO) :-
HeadBI = simple_bound_functor(Name, ArgInsts),
io.format(Stream, "%s%s", [s(ArrowOrSemi), s(Name)], !IO),
(
ArgInsts = []
;
ArgInsts = [_ | _],
io.write_string(Stream, "(", !IO),
mercury_output_inst_list(Stream, Lang, InstVarSet, ArgInsts, !IO),
io.write_string(Stream, ")", !IO)
),
(
TailBIs = [],
io.write_string(Stream, ".\n", !IO)
;
TailBIs = [HeadTailBI | TailTailBIs],
io.write_string(Stream, "\n", !IO),
output_bound_inst_being_defined(Stream, Lang, InstVarSet,
" ; ", HeadTailBI, TailTailBIs, !IO)
).
%---------------------------------------------------------------------------%
mercury_output_item_mode_defn(Info, Stream, ItemModeDefn, !IO) :-
ItemModeDefn = item_mode_defn_info(SymName, InstParams,
MaybeAbstractModeDefn, VarSet, Context, _SeqNum),
maybe_unqualify_sym_name(Info, SymName, UnQualSymName),
maybe_output_line_number(Info, Context, Stream, !IO),
Lang = get_output_lang(Info),
mercury_format_mode_defn(Lang, VarSet, Context, UnQualSymName, InstParams,
MaybeAbstractModeDefn, Stream, !IO).
% This is defined to work on !U instead of !IO so that we can call
% mercury_format_mode with simple_inst_info.
%
:- pred mercury_format_mode_defn(output_lang::in, inst_varset::in,
prog_context::in, sym_name::in, list(inst_var)::in,
maybe_abstract_mode_defn::in, S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_mode_defn(Lang, InstVarSet, Context, Name, Args,
MaybeAbstractModeDefn, S, !U) :-
(
MaybeAbstractModeDefn = abstract_mode_defn,
add_string(":- abstract_mode((", S, !U),
mercury_format_mode_defn_head(InstVarSet, Context, Name, Args, S, !U),
add_string(")).\n", S, !U)
;
MaybeAbstractModeDefn = nonabstract_mode_defn(eqv_mode(Mode)),
add_string(":- mode (", S, !U),
mercury_format_mode_defn_head(InstVarSet, Context, Name, Args, S, !U),
add_string(") == ", S, !U),
mercury_format_mode(Lang, InstVarSet, Mode, S, !U),
add_string(".\n", S, !U)
).
:- pred mercury_format_mode_defn_head(inst_varset::in, prog_context::in,
sym_name::in, list(inst_var)::in, S::in,
U::di, U::uo) is det <= output(S, U).
mercury_format_mode_defn_head(InstVarSet, Context, Name, Args, S, !U) :-
ArgTerms = list.map(func(V) = variable(V, Context), Args),
construct_qualified_term_with_context(Name, ArgTerms, Context, ModeTerm),
mercury_format_term_vs(InstVarSet, print_name_only, ModeTerm, S, !U).
%---------------------------------------------------------------------------%
% Output the given predicate declaration, after
%
% - Maybe Unqualifying the predicate name, and
% - Maybe writing out the line number Context.
%
:- pred mercury_output_item_pred_decl_mu_mc(merc_out_info::in,
var_name_print::in, io.text_output_stream::in, item_pred_decl_info::in,
io::di, io::uo) is det.
mercury_output_item_pred_decl_mu_mc(Info, VarNamePrint, Stream,
ItemPredDecl0, !IO) :-
MaybeQualifiedItemNames = get_maybe_qualified_item_names(Info),
(
MaybeQualifiedItemNames = qualified_item_names,
ItemPredDecl = ItemPredDecl0
;
MaybeQualifiedItemNames = unqualified_item_names,
PredSymName0 = ItemPredDecl0 ^ pf_name,
PredSymName = unqualified(unqualify_name(PredSymName0)),
ItemPredDecl = ItemPredDecl0 ^ pf_name := PredSymName
),
maybe_output_line_number(Info, ItemPredDecl ^ pf_context, Stream, !IO),
Lang = get_output_lang(Info),
mercury_output_item_pred_decl(Lang, VarNamePrint, Stream,
ItemPredDecl, !IO).
mercury_output_item_pred_decl(Lang, VarNamePrint, Stream, ItemPredDecl, !IO) :-
% Most of the code that outputs pred declarations is in
% parse_tree_out_pred_decl.m.
ItemPredDecl = item_pred_decl_info(PredSymName, PredOrFunc, TypesAndModes,
WithType, WithInst, MaybeDetism, _Origin, TypeVarSet, InstVarSet,
ExistQVars, Purity, Constraints, _Context, _SeqNum),
( if
% Function declarations using `with_type` have the same format
% as predicate declarations, but with `func' instead of `pred'.
PredOrFunc = pf_function,
WithType = no
then
pred_args_to_func_args(TypesAndModes, FuncTypesAndModes,
RetTypeAndMode),
mercury_format_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, ExistQVars,
PredSymName, FuncTypesAndModes, RetTypeAndMode, MaybeDetism,
Purity, Constraints, ":- ", ".\n", ".\n", Stream, !IO)
else
mercury_format_pred_or_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, PredOrFunc, ExistQVars,
PredSymName, TypesAndModes, WithType, WithInst, MaybeDetism,
Purity, Constraints, ":- ", ".\n", ".\n", Stream, !IO)
).
%---------------------------------------------------------------------------%
mercury_output_item_mode_decl(Info, Stream, ItemModeDecl, !IO) :-
% Most of the code that outputs mode declarations is in
% parse_tree_out_pred_decl.m.
ItemModeDecl = item_mode_decl_info(PredSymName0, MaybePredOrFunc, ArgModes,
MaybeWithInst, MaybeDetism, InstVarSet, Context, _SeqNum),
maybe_unqualify_sym_name(Info, PredSymName0, PredSymName),
maybe_output_line_number(Info, Context, Stream, !IO),
Lang = get_output_lang(Info),
( if
% Function mode declarations using `with_type` have the same format
% as predicate mode declarations.
MaybePredOrFunc = yes(pf_function),
MaybeWithInst = no
then
pred_args_to_func_args(ArgModes, FuncArgModes, ReturnMode),
mercury_output_func_mode_decl(Stream, Lang, InstVarSet, PredSymName,
FuncArgModes, ReturnMode, MaybeDetism, !IO)
else
mercury_output_pred_mode_decl(Stream, Lang, InstVarSet, PredSymName,
ArgModes, MaybeWithInst, MaybeDetism, !IO)
).
%---------------------------------------------------------------------------%
mercury_format_item_foreign_enum(_Info, S, ItemForeignEnum, !U) :-
ItemForeignEnum = item_foreign_enum_info(Lang, TypeCtor, OoMValues,
_Context, _SeqNum),
add_string(":- pragma foreign_enum(", S, !U),
mercury_format_foreign_language_string(Lang, S, !U),
add_string(", ", S, !U),
TypeCtor = type_ctor(TypeName, TypeArity),
mercury_format_bracketed_sym_name_ngt(next_to_graphic_token, TypeName,
S, !U),
add_string("/", S, !U),
add_int(TypeArity, S, !U),
add_string(", ", S, !U),
Values = one_or_more_to_list(OoMValues),
mercury_format_unqual_sym_name_string_assoc_list(Values, S, !U),
add_string(").\n", S, !U).
% Output an association list of to-be-unqualified sym_names and strings.
% The strings will be quoted in the output.
%
:- pred mercury_format_unqual_sym_name_string_assoc_list(
assoc_list(sym_name, string)::in, S::in,
U::di, U::uo) is det <= output(S, U).
mercury_format_unqual_sym_name_string_assoc_list(AssocList, S, !U) :-
add_char('[', S, !U),
add_list(mercury_format_unqual_sym_name_string_pair, ", ",
AssocList, S, !U),
add_char(']', S, !U).
:- pred mercury_format_unqual_sym_name_string_pair(
pair(sym_name, string)::in, S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_unqual_sym_name_string_pair(SymName0 - String, S, !U) :-
Name = unqualify_name(SymName0),
SymName = unqualified(Name),
mercury_format_bracketed_sym_name_ngt(next_to_graphic_token, SymName,
S, !U),
add_string(" - ", S, !U),
add_quoted_string(String, S, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_foreign_export_enum(merc_out_info::in,
item_foreign_export_enum_info::in, S::in,
U::di, U::uo) is det <= output(S, U).
mercury_format_item_foreign_export_enum(_Info, ItemForeignExportEnum, S, !U) :-
ItemForeignExportEnum = item_foreign_export_enum_info(Lang, TypeCtor,
Attributes, Overrides, _Context, _SeqNum),
add_string(":- pragma foreign_export_enum(", S, !U),
mercury_format_foreign_language_string(Lang, S, !U),
add_string(", ", S, !U),
TypeCtor = type_ctor(TypeName, TypeArity),
mercury_format_bracketed_sym_name_ngt(next_to_graphic_token, TypeName,
S, !U),
add_string("/", S, !U),
add_int(TypeArity, S, !U),
add_string(", ", S, !U),
mercury_format_foreign_export_enum_attributes(Attributes, S, !U),
add_string(", ", S, !U),
mercury_format_sym_name_string_assoc_list(Overrides, S, !U),
add_string(").\n", S, !U).
:- pred mercury_format_foreign_export_enum_attributes(
export_enum_attributes::in, S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_foreign_export_enum_attributes(Attributes, S, !U) :-
MaybePrefix = Attributes ^ ee_attr_prefix,
add_string("[", S, !U),
(
MaybePrefix = no
;
MaybePrefix = yes(Prefix),
add_string("prefix(", S, !U),
add_quoted_string(Prefix, S, !U),
add_char(')', S, !U)
),
add_string("]", S, !U).
% Output an association list of sym_names and strings.
% The strings will be quoted in the output.
%
:- pred mercury_format_sym_name_string_assoc_list(
assoc_list(sym_name, string)::in, S::in,
U::di, U::uo) is det <= output(S, U).
mercury_format_sym_name_string_assoc_list(AssocList, S, !U) :-
add_char('[', S, !U),
add_list(mercury_format_sym_name_string_pair, ", ", AssocList, S, !U),
add_char(']', S, !U).
:- pred mercury_format_sym_name_string_pair(
pair(sym_name, string)::in, S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_sym_name_string_pair(SymName - String, S, !U) :-
mercury_format_bracketed_sym_name_ngt(next_to_graphic_token, SymName,
S, !U),
add_string(" - ", S, !U),
add_quoted_string(String, S, !U).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_promise(merc_out_info::in,
io.text_output_stream::in, item_promise_info::in, io::di, io::uo) is det.
mercury_output_item_promise(_, Stream, ItemPromise, !IO) :-
% Any changes here may require similar changes in the write_promise
% predicate in intermod.m.
ItemPromise = item_promise_info(PromiseType, Goal, VarSet, UnivVars,
_Context, _SeqNum),
UnivVarStrs = list.map(varset.lookup_name(VarSet), UnivVars),
UnivVarsStr = string.join_list(", ", UnivVarStrs),
% The parentheses around the goal are required; without them,
% operator precedence problems prevent the parser from being able
% to read back in the promises we write out.
(
PromiseType = promise_type_true,
io.format(Stream, ":- promise all [%s] (\n", [s(UnivVarsStr)], !IO)
;
( PromiseType = promise_type_exclusive
; PromiseType = promise_type_exhaustive
; PromiseType = promise_type_exclusive_exhaustive
),
io.format(Stream, ":- all [%s]\n%s\n(\n",
[s(UnivVarsStr), s(promise_to_string(PromiseType))], !IO)
),
Indent = 1,
mercury_output_goal(Stream, VarSet, Indent, Goal, !IO),
io.write_string(Stream, "\n).\n", !IO).
%---------------------------------------------------------------------------%
mercury_output_item_typeclass(Info, Stream, ItemTypeClass, !IO) :-
ItemTypeClass = item_typeclass_info(ClassName0, Vars, Constraints, FunDeps,
Interface, VarSet, _Context, _SeqNum),
maybe_unqualify_sym_name(Info, ClassName0, ClassName),
ClassNameStr = mercury_sym_name_to_string(ClassName),
VarStrs = list.map(varset.lookup_name(VarSet), Vars),
VarsStr = string.join_list(", ", VarStrs),
io.format(Stream, ":- typeclass %s(%s)",
[s(ClassNameStr), s(VarsStr)], !IO),
mercury_format_fundeps_and_prog_constraint_list(VarSet, print_name_only,
FunDeps, Constraints, Stream, !IO),
(
Interface = class_interface_abstract,
io.write_string(Stream, ".\n", !IO)
;
Interface = class_interface_concrete(ClassDecls),
io.write_string(Stream, " where [\n", !IO),
Lang = get_output_lang(Info),
output_class_decls(Stream, Lang, print_name_only, ClassDecls, !IO),
io.write_string(Stream, "\n].\n", !IO)
).
:- pred mercury_format_fundeps_and_prog_constraint_list(tvarset::in,
var_name_print::in, list(prog_fundep)::in, list(prog_constraint)::in,
S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_fundeps_and_prog_constraint_list(VarSet, VarNamePrint,
FunDeps, Constraints, S, !U) :-
( if
FunDeps = [],
Constraints = []
then
true
else
add_string(" <= (", S, !U),
add_list(mercury_format_fundep(VarSet, VarNamePrint), ", ", FunDeps,
S, !U),
(
Constraints = []
;
Constraints = [_ | _],
(
FunDeps = []
;
FunDeps = [_ | _],
add_string(", ", S, !U)
),
add_list(mercury_format_constraint(VarSet, VarNamePrint),
", ", Constraints, S, !U)
),
add_string(")", S, !U)
).
:- pred mercury_format_fundep(tvarset::in, var_name_print::in, prog_fundep::in,
S::in, U::di, U::uo) is det <= output(S, U).
mercury_format_fundep(TypeVarSet, VarNamePrint, fundep(Domain, Range),
S, !U) :-
add_string("(", S, !U),
add_list(mercury_format_var_vs(TypeVarSet, VarNamePrint), ", ", Domain,
S, !U),
add_string(" -> ", S, !U),
add_list(mercury_format_var_vs(TypeVarSet, VarNamePrint), ", ", Range,
S, !U),
add_string(")", S, !U).
:- pred output_class_decls(io.text_output_stream::in,
output_lang::in, var_name_print::in, list(class_decl)::in,
io::di, io::uo) is det.
output_class_decls(Stream, Lang, VarNamePrint, ClassDecls, !IO) :-
write_out_list(output_class_decl(Lang, VarNamePrint), ",\n",
ClassDecls, Stream, !IO).
:- pred output_class_decl(output_lang::in, var_name_print::in, class_decl::in,
io.text_output_stream::in, io::di, io::uo) is det.
output_class_decl(Lang, VarNamePrint, Decl, Stream, !IO) :-
io.write_string(Stream, "\t", !IO),
(
Decl = class_decl_pred_or_func(PredOrFuncInfo),
PredOrFuncInfo = class_pred_or_func_info(SymName, PredOrFunc,
TypesAndModes, WithType, WithInst, MaybeDetism,
TypeVarSet, InstVarSet, ExistQVars, Purity,
Constraints, _Context),
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
Name = unqualify_name(SymName),
( if
% Function declarations using `with_type` have the same format
% as predicate declarations, but with `func' instead of `pred'.
PredOrFunc = pf_function,
WithType = no
then
pred_args_to_func_args(TypesAndModes,
FuncTypesAndModes, RetTypeAndMode),
mercury_format_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, ExistQVars,
unqualified(Name), FuncTypesAndModes, RetTypeAndMode,
MaybeDetism, Purity, Constraints, "", ",\n\t", "", Stream, !IO)
else
mercury_format_pred_or_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, PredOrFunc, ExistQVars,
unqualified(Name), TypesAndModes, WithType, WithInst,
MaybeDetism, Purity, Constraints, "", ",\n\t", "", Stream, !IO)
)
;
Decl = class_decl_mode(ModeInfo),
ModeInfo = class_mode_info(SymName, PredOrFunc, Modes,
WithInst, MaybeDetism, InstVarSet, _Context),
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
Name = unqualify_name(SymName),
( if
% Function mode declarations using `with_type` have the same format
% as predicate mode declarations.
PredOrFunc = yes(pf_function),
WithInst = no
then
pred_args_to_func_args(Modes, FuncModes, RetMode),
mercury_format_func_mode_decl(Lang, InstVarSet,
unqualified(Name), FuncModes, RetMode, MaybeDetism,
"", "", Stream, !IO)
else
mercury_format_pred_or_func_mode_decl(Lang, InstVarSet,
unqualified(Name), Modes, WithInst, MaybeDetism,
"", "", Stream, !IO)
)
).
%---------------------------------------------------------------------------%
mercury_output_item_instance(_, Stream, ItemInstance, !IO) :-
% XXX When prettyprinting a Mercury module, we want to print the original
% types. When generating interface types, we want to print the
% equiv-type-expanded types. We do the latter.
ItemInstance = item_instance_info(ClassName,Types, _OriginalTypes,
Constraints, Body, VarSet, _InstanceModuleName, _Context, _SeqNum),
io.write_string(Stream, ":- instance ", !IO),
% We put an extra set of brackets around the class name in case
% the name is an operator.
io.write_char(Stream, '(', !IO),
mercury_output_sym_name(ClassName, Stream, !IO),
io.write_char(Stream, '(', !IO),
write_out_list(mercury_output_type(VarSet, print_name_only),
", ", Types, Stream, !IO),
io.write_char(Stream, ')', !IO),
io.write_char(Stream, ')', !IO),
mercury_format_prog_constraint_list(VarSet, print_name_only, "<=",
Constraints, Stream, !IO),
(
Body = instance_body_abstract
;
Body = instance_body_concrete(Methods),
io.write_string(Stream, " where [\n", !IO),
mercury_output_instance_methods(Stream, Methods, !IO),
io.write_string(Stream, "\n]", !IO)
),
io.write_string(Stream, ".\n", !IO).
:- pred mercury_output_instance_methods(io.text_output_stream::in,
list(instance_method)::in, io::di, io::uo) is det.
mercury_output_instance_methods(Stream, Methods, !IO) :-
write_out_list(mercury_output_instance_method,
",\n", Methods, Stream, !IO).
mercury_output_instance_method(Method, Stream, !IO) :-
Method = instance_method(MethodId, Defn, _Context),
MethodId = pred_pf_name_arity(PredOrFunc, MethodSymName, UserArity),
UserArity = user_arity(UserArityInt),
(
Defn = instance_proc_def_name(PredName),
% XXX ARITY io.format
io.write_char(Stream, '\t', !IO),
(
PredOrFunc = pf_function,
io.write_string(Stream, "func(", !IO)
;
PredOrFunc = pf_predicate,
io.write_string(Stream, "pred(", !IO)
),
mercury_output_bracketed_sym_name_ngt(next_to_graphic_token,
MethodSymName, Stream, !IO),
io.write_string(Stream, "/", !IO),
io.write_int(Stream, UserArityInt, !IO),
io.write_string(Stream, ") is ", !IO),
mercury_output_bracketed_sym_name(PredName, Stream, !IO)
;
Defn = instance_proc_def_clauses(ItemsCord),
Items = cord.list(ItemsCord),
% XXX should we output the term contexts?
io.write_string(Stream, "\t(", !IO),
write_out_list(output_instance_method_clause(MethodSymName),
"),\n\t(", Items, Stream, !IO),
io.write_string(Stream, ")", !IO)
).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_initialise(merc_out_info::in,
io.text_output_stream::in, item_initialise_info::in,
io::di, io::uo) is det.
mercury_output_item_initialise(_, Stream, ItemInitialise, !IO) :-
ItemInitialise = item_initialise_info(PredSymName, UserArity, _, _Context,
_SeqNum),
PredSymNameStr = mercury_bracketed_sym_name_to_string(PredSymName),
UserArity = user_arity(UserArityInt),
io.format(Stream, ":- initialise %s/%d.\n",
[s(PredSymNameStr), i(UserArityInt)], !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_finalise(merc_out_info::in,
io.text_output_stream::in, item_finalise_info::in, io::di, io::uo) is det.
mercury_output_item_finalise(_, Stream, ItemFinalise, !IO) :-
ItemFinalise = item_finalise_info(PredSymName, UserArity, _, _Context,
_SeqNum),
PredSymNameStr = mercury_bracketed_sym_name_to_string(PredSymName),
UserArity = user_arity(UserArityInt),
io.format(Stream, ":- finalise %s/%d.\n",
[s(PredSymNameStr), i(UserArityInt)], !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_mutable(merc_out_info::in,
io.text_output_stream::in, item_mutable_info::in, io::di, io::uo) is det.
mercury_output_item_mutable(Info, Stream, ItemMutable, !IO) :-
ItemMutable = item_mutable_info(Name, _OrigType, Type, _OrigInst, Inst,
InitTerm, MutVarSet, Attrs, _Context, _SeqNum),
io.write_string(Stream, ":- mutable(", !IO),
io.write_string(Stream, Name, !IO),
io.write_string(Stream, ", ", !IO),
mercury_output_type(varset.init, print_name_only, Type, Stream, !IO),
io.write_string(Stream, ", ", !IO),
% See the comments for read_mutable_decl for the reason we _must_ use
% MutVarSet here.
mercury_output_term_vs(MutVarSet, print_name_only, InitTerm, Stream, !IO),
io.write_string(Stream, ", ", !IO),
Lang = get_output_lang(Info),
mercury_output_inst(Stream, Lang, varset.init, Inst, !IO),
io.write_string(Stream, ", ", !IO),
io.print(Stream, Attrs, !IO),
io.write_string(Stream, ").\n", !IO).
:- pred mercury_output_item_mutable_2(merc_out_info::in, item_mutable_info::in,
io.text_output_stream::in, io::di, io::uo) is det.
mercury_output_item_mutable_2(Info, ItemMutable, Stream, !IO) :-
mercury_output_item_mutable(Info, Stream, ItemMutable, !IO).
%---------------------------------------------------------------------------%
:- pred mercury_output_item_foreign_import_module(io.text_output_stream::in,
item_fim::in, io::di, io::uo) is det.
mercury_output_item_foreign_import_module(Stream, ItemFIM, !IO) :-
ItemFIM = item_fim(Lang, ModuleName, _Context, _SeqNum),
FIMSpec = fim_spec(Lang, ModuleName),
mercury_output_fim_spec(Stream, FIMSpec, !IO).
mercury_output_fim_spec(Stream, FIMSpec, !IO) :-
FIMSpec = fim_spec(Lang, ModuleName),
io.write_string(Stream, ":- pragma foreign_import_module(", !IO),
mercury_format_foreign_language_string(Lang, Stream, !IO),
io.write_string(Stream, ", ", !IO),
mercury_output_bracketed_sym_name_ngt(not_next_to_graphic_token,
ModuleName, Stream, !IO),
io.write_string(Stream, ").\n", !IO).
%---------------------------------------------------------------------------%
maybe_write_block_start_blank_line(Stream, Items, !IO) :-
(
Items = []
;
Items = [_ | _],
io.nl(Stream, !IO)
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.parse_tree_out.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink