mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-18 19:03:45 +00:00
Code Issues Projects Releases Wiki Activity
Files
b357a3dadcdf29c8d8ca184d65f7634a1a94de36
mercury/compiler/parse_tree_out.m
Zoltan Somogyi ffb963b30f Add code to write parse trees to a string. 
Traditionally, we always wrote out parse trees (of .intN files, for example)
to a file. However, we have also supported being able to write out *parts*
of parse trees to strings, because that ability is useful e.g.

- in error messages, printing the code that the error message is about,
- when debugging.

We are considering a use case which requires the ability to write out
the *whole* parse tree of a .intN file to a string. That use case is
comparing whether the old and new versions of a .intN file are identical
or not, because we want to update the actual .intN file only if they
differ. (Updating the .intN file if they are identical could trigger
the unnecessary recompilation of an unbounded number of other modules.)

Previously, we have done this comparison by writing out the new parse tree
to an .intN.tmp file, and compared it to the .intN file. It should be simpler
and quite possibly faster to

- read in the old .intN file as a string
- convert the new parse tree to a string
- compare the two strings
- write out the new string if and only if it differs from the old string.

This should be especially so if we can open the .intN file in read-write mode,
so the file would need to be opened just once, in step one, even if we do
need to write out the new parse tree in step four.

compiler/parse_tree_out.m:
    Add functions to convert parse_tree_int[0123]s to strings.

    To avoid having to reimplement all the code that currently writes
    out those parse trees, convert the current predicates that always do I/O
    into predicates that use the methods of the existing pt_output type class,
    which, depending on the selected instance, can either do I/O or can build
    up a string. This conversion has already been done for the constructs
    that make up some parts of those parse trees; this diff extends the
    conversion to every construct that is part of parse trees listed above.

    As part of our existing conventions, predicates that have been
    generalized in this way have the "output" or "write" in their names
    replaced with "format".

    We also perform this generalization for the predicates that write out
    parse_tree_srcs and parse_tree_module_srcs, because doing so requires
    almost no extra code.

compiler/parse_item.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_info.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_misc.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_type_repn.m:
compiler/prog_ctgc.m:
    Perform the generalization discussed above, both on predicates
    that write out Mercury constructs, and on some auxiliary predicates.

    In a few cases, the generalized versions already existed but were private,
    in which case this diff just exports them.

    In a few cases, rename predicates to avoid ambiguities.

compiler/add_clause.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_type_table.m:
compiler/hlds_out_typeclass_table.m:
compiler/intermod.m:
compiler/intermod_analysis.m:
    Conform to the changes above.
2023-11-01 19:53:40 +11:00

2389 lines
98 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, Globals,
% OutputFileName, ParseTree, Succeeded, !IO).
:- pred output_parse_tree_src(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, 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, 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, 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, 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, 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, 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_format_parse_tree_src(merc_out_info::in,
S::in, parse_tree_src::in, U::di, U::uo) is det <= pt_output(S, U).
:- 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_format_parse_tree_module_src(merc_out_info::in, S::in,
parse_tree_module_src::in, U::di, U::uo) is det <= pt_output(S, U).
:- 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.
:- func parse_tree_int0_to_string(merc_out_info, parse_tree_int0) = string.
:- func parse_tree_int1_to_string(merc_out_info, parse_tree_int1) = string.
:- func parse_tree_int2_to_string(merc_out_info, parse_tree_int2) = string.
:- func parse_tree_int3_to_string(merc_out_info, parse_tree_int3) = string.
:- pred mercury_format_parse_tree_int0(merc_out_info::in, S::in,
parse_tree_int0::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_parse_tree_int1(merc_out_info::in, S::in,
parse_tree_int1::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_parse_tree_int2(merc_out_info::in, S::in,
parse_tree_int2::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_parse_tree_int3(merc_out_info::in, S::in,
parse_tree_int3::in, U::di, U::uo) is det <= pt_output(S, U).
:- 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.
:- pred mercury_format_parse_tree_plain_opt(merc_out_info::in, S::in,
parse_tree_plain_opt::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_parse_tree_trans_opt(merc_out_info::in, S::in,
parse_tree_trans_opt::in, U::di, U::uo) is det <= pt_output(S, U).
%---------------------------------------------------------------------------%
% 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_format_module_decl(S::in, string::in, module_name::in,
U::di, U::uo) is det <= pt_output(S, U).
%---------------------------------------------------------------------------%
:- pred mercury_format_item(merc_out_info::in, S::in, item::in,
U::di, U::uo) is det <= pt_output(S, U).
%---------------------------------------------------------------------------%
%
% Output some components of type definitions.
%
:- pred mercury_format_item_type_defn(merc_out_info::in, S::in,
item_type_defn_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_where_attributes(merc_out_info::in, tvarset::in,
maybe(solver_type_details)::in, maybe_canonical::in,
maybe(list(sym_name_arity))::in, S::in, U::di, U::uo) is det
<= pt_output(S, U).
:- pred mercury_format_ctor(tvarset::in, constructor::in,
S::in, U::di, U::uo) is det <= pt_output(S, U).
:- 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_format_item_inst_defn(merc_out_info::in, S::in,
item_inst_defn_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_mode_defn(merc_out_info::in, S::in,
item_mode_defn_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_pred_decl(output_lang::in, var_name_print::in,
S::in, item_pred_decl_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_mode_decl(merc_out_info::in,
S::in, item_mode_decl_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_foreign_enum(merc_out_info::in, S::in,
item_foreign_enum_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_typeclass(merc_out_info::in,
S::in, item_typeclass_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- pred mercury_format_item_abstract_typeclass(merc_out_info::in,
S::in, item_abstract_typeclass_info::in, U::di, U::uo) is det
<= pt_output(S, U).
%---------------------------------------------------------------------------%
%
% Output some components of an instance definition.
%
:- pred mercury_format_item_instance(merc_out_info::in, S::in,
item_instance_info::in, U::di, U::uo) is det <= pt_output(S, U).
:- func item_abstract_instance_to_string(merc_out_info,
item_abstract_instance_info) = string.
:- pred mercury_format_item_abstract_instance(merc_out_info::in,
S::in, item_abstract_instance_info::in, U::di, U::uo) is det
<= pt_output(S, U).
:- pred mercury_format_instance_method(instance_method::in, S::in,
U::di, U::uo) is det <= pt_output(S, U).
%---------------------------------------------------------------------------%
%
% 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.
:- pred mercury_format_fim_spec(S::in, fim_spec::in, U::di, U::uo) is det
<= pt_output(S, U).
%---------------------------------------------------------------------------%
% Print a blank line if the given list is not empty.
%
:- pred maybe_format_block_start_blank_line(S::in, list(T)::in,
U::di, U::uo) is det <= pt_output(S, U).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- 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 ops.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module string.builder.
:- import_module term.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
output_parse_tree_src(ProgressStream, Globals,
OutputFileName, ParseTreeSrc, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_src, ParseTreeSrc,
Succeeded, !IO).
%---------------------%
output_parse_tree_int0(ProgressStream, Globals,
OutputFileName, ParseTreeInt0, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_int0, ParseTreeInt0,
Succeeded, !IO).
output_parse_tree_int1(ProgressStream, Globals,
OutputFileName, ParseTreeInt1, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_int1, ParseTreeInt1,
Succeeded, !IO).
output_parse_tree_int2(ProgressStream, Globals,
OutputFileName, ParseTreeInt2, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_int2, ParseTreeInt2,
Succeeded, !IO).
output_parse_tree_int3(ProgressStream, Globals,
OutputFileName, ParseTreeInt3, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_int3, ParseTreeInt3,
Succeeded, !IO).
%---------------------%
output_parse_tree_plain_opt(ProgressStream, Globals,
OutputFileName, ParseTreePlainOpt, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, Globals,
OutputFileName, mercury_output_parse_tree_plain_opt, ParseTreePlainOpt,
Succeeded, !IO).
output_parse_tree_trans_opt(ProgressStream, Globals,
OutputFileName, ParseTreeTransOpt, Succeeded, !IO) :-
output_some_parse_tree(ProgressStream, 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, 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, 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(ProgressStream,
"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) :-
mercury_format_parse_tree_src(Info, Stream, ParseTree, !IO).
mercury_format_parse_tree_src(Info, S, ParseTree, !U) :-
ParseTree = parse_tree_src(ModuleName, _Context, ModuleComponentsCord),
mercury_format_module_decl(S, "module", ModuleName, !U),
ModuleComponents = cord.list(ModuleComponentsCord),
mercury_format_module_components(Info, S, no, ModuleComponents, !U),
mercury_format_module_decl(S, "end_module", ModuleName, !U).
%---------------------------------------------------------------------------%
mercury_output_parse_tree_module_src(Info, Stream, ParseTreeModuleSrc, !IO) :-
mercury_format_parse_tree_module_src(Info, Stream,
ParseTreeModuleSrc, !IO).
mercury_format_parse_tree_module_src(Info, S, ParseTreeModuleSrc, !U) :-
ParseTreeModuleSrc = parse_tree_module_src(ModuleName, _ModuleContext,
InclMap, ImportUseMap,
IntFIMSpecMap, ImpFIMSpecMap, IntSelfFIMLangs, ImpSelfFIMLangs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
_TypeSpecs, _InstModeSpecs,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises, _IntBadPreds,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpClauses, ImpForeignProcs, ImpForeignExportEnums,
ImpDeclPragmas, ImpDeclMarkers, ImpImplPragmas, ImpImplMarkers,
ImpPromises, ImpInitialises, ImpFinalises, ImpMutables),
include_map_to_int_imp_modules(InclMap, IntInclModules, ImpInclModules),
import_and_or_use_map_to_explicit_int_imp_import_use_maps(ImportUseMap,
_SectionImportUseMap,
IntImportMap, IntUseMap, ImpImportMap, ImpUseMap),
IntImportMap = int_import_context_map(IntImportMap0),
IntUseMap = int_use_context_map(IntUseMap0),
ImpImportMap = imp_import_context_map(ImpImportMap0),
ImpUseMap = imp_use_context_map(ImpUseMap0),
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),
add_string("% module src\n", S, !U),
mercury_format_module_decl(S, "module", ModuleName, !U),
add_string("% include_module_map\n", S, !U),
map.foldl(format_include_module_map_entry(S), InclMap, !U),
add_string("% section_import_and_or_use_map\n", S, !U),
map.foldl(format_import_use_map_entry(S), ImportUseMap, !U),
mercury_format_section_marker(S, ms_interface, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
IntInclModules, !U),
list.foldl(mercury_format_module_decl(S, "import_module"),
map.keys(IntImportMap0), !U),
list.foldl(mercury_format_module_decl(S, "use_module"),
map.keys(IntUseMap0), !U),
list.foldl(mercury_format_fim_spec(S), map.keys(IntFIMSpecMap), !U),
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)),
add_string("% implicit interface FIM self-import languages: ", S, !U),
add_string(string.join_list(", ", IntSelfFIMLangStrs), S, !U),
add_string("\n", S, !U),
add_string("% implicit implementation FIM self-import languages: ", S, !U),
add_string(string.join_list(", ", ImpSelfFIMLangStrs), S, !U),
add_string("\n", S, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
IntTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
IntInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
IntModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
IntTypeClasses, !U),
list.foldl(mercury_format_item_instance(Info, S),
IntInstances, !U),
list.foldl(
mercury_format_item_pred_decl_mu_mc(Info, print_name_only, S),
IntPredDecls, !U),
list.foldl(mercury_format_item_mode_decl(Info, S),
IntModeDecls, !U),
list.foldl(mercury_format_item_decl_pragma(Info, S),
IntDeclPragmas, !U),
list.foldl(mercury_format_item_decl_marker(S),
IntDeclMarkers, !U),
list.foldl(mercury_format_item_promise(Info, S),
IntPromises, !U),
mercury_format_section_marker(S, ms_implementation, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
ImpInclModules, !U),
list.foldl(mercury_format_module_decl(S, "import_module"),
map.keys(ImpImportMap0), !U),
list.foldl(mercury_format_module_decl(S, "use_module"),
map.keys(ImpUseMap0), !U),
list.foldl(mercury_format_fim_spec(S), map.keys(ImpFIMSpecMap), !U),
list.foldl(mercury_format_item_type_defn(Info, S),
ImpTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
ImpInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
ImpModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
ImpTypeClasses, !U),
list.foldl(mercury_format_item_instance(Info, S),
ImpInstances, !U),
list.foldl(
mercury_format_item_pred_decl_mu_mc(Info, print_name_only, S),
ImpPredDecls, !U),
list.foldl(mercury_format_item_mode_decl(Info, S),
ImpModeDecls, !U),
list.foldl(mercury_format_item_clause(Info, S),
ImpClauses, !U),
list.foldl(mercury_format_item_foreign_proc(S, get_output_lang(Info)),
ImpForeignProcs, !U),
list.foldl(mercury_format_item_foreign_enum(Info, S),
ImpForeignEnums, !U),
list.foldl(mercury_format_item_foreign_export_enum(Info, S),
ImpForeignExportEnums, !U),
list.foldl(mercury_format_item_decl_pragma(Info, S),
ImpDeclPragmas, !U),
list.foldl(mercury_format_item_decl_marker(S),
ImpDeclMarkers, !U),
list.foldl(mercury_format_item_impl_pragma(Info, S),
ImpImplPragmas, !U),
list.foldl(mercury_format_item_impl_marker(S),
ImpImplMarkers, !U),
list.foldl(mercury_format_item_promise(Info, S),
ImpPromises, !U),
list.foldl(mercury_format_item_initialise(Info, S),
ImpInitialises, !U),
list.foldl(mercury_format_item_finalise(Info, S),
ImpFinalises, !U),
list.foldl(mercury_format_item_mutable(Info, S),
ImpMutables, !U),
mercury_format_module_decl(S, "end_module", ModuleName, !U),
add_string("\n", S, !U).
:- pred format_include_module_map_entry(S::in,
module_name::in, include_module_info::in, U::di, U::uo) is det
<= pt_output(S, U).
format_include_module_map_entry(S, ModuleName, InclInfo, !U) :-
InclInfo = include_module_info(Section, _Context),
(
Section = ms_interface,
MarkerStr = "interface"
;
Section = ms_implementation,
MarkerStr = "implementation"
),
add_string("% ", S, !U),
mercury_format_bracketed_sym_name(ModuleName, S, !U),
add_string(" -> ", S, !U),
add_string(MarkerStr, S, !U),
add_string("\n", S, !U).
:- pred format_import_use_map_entry(S::in, module_name::in,
maybe_implicit_import_and_or_use::in, U::di, U::uo) is det
<= pt_output(S, U).
format_import_use_map_entry(S, ModuleName, ImportAndOrUse, !U) :-
(
ImportAndOrUse = explicit_avail(SectionImportAndOrUse),
(
SectionImportAndOrUse = int_import(_),
KindStr = "int_import"
;
SectionImportAndOrUse = int_use(_),
KindStr = "int_use"
;
SectionImportAndOrUse = imp_import(_),
KindStr = "imp_import"
;
SectionImportAndOrUse = imp_use(_),
KindStr = "imp_use"
;
SectionImportAndOrUse = int_use_imp_import(_, _),
KindStr = "int_use_imp_import"
)
;
ImportAndOrUse = implicit_avail(ImplicitImportAndOrUse, _),
(
ImplicitImportAndOrUse = implicit_int_import,
KindStr = "implicit_int_import"
;
ImplicitImportAndOrUse = implicit_int_use,
KindStr = "implicit_int_use"
;
ImplicitImportAndOrUse = implicit_imp_use,
KindStr = "implicit_imp_use"
)
),
add_string("% ", S, !U),
mercury_format_bracketed_sym_name(ModuleName, S, !U),
add_string(" -> ", S, !U),
add_string(KindStr, S, !U),
add_string("\n", S, !U).
%---------------------------------------------------------------------------%
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) :-
mercury_format_parse_tree_int0(Info, Stream, ParseTreeInt0, !IO).
mercury_output_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO) :-
mercury_format_parse_tree_int1(Info, Stream, ParseTreeInt1, !IO).
mercury_output_parse_tree_int2(Info, Stream, ParseTreeInt2, !IO) :-
mercury_format_parse_tree_int2(Info, Stream, ParseTreeInt2, !IO).
mercury_output_parse_tree_int3(Info, Stream, ParseTreeInt3, !IO) :-
mercury_format_parse_tree_int3(Info, Stream, ParseTreeInt3, !IO).
%---------------------------------------------------------------------------%
parse_tree_int0_to_string(Info, ParseTreeInt0) = Str :-
State0 = string.builder.init,
mercury_format_parse_tree_int0(Info, string.builder.handle, ParseTreeInt0,
State0, State),
Str = string.builder.to_string(State).
parse_tree_int1_to_string(Info, ParseTreeInt1) = Str :-
State0 = string.builder.init,
mercury_format_parse_tree_int1(Info, string.builder.handle, ParseTreeInt1,
State0, State),
Str = string.builder.to_string(State).
parse_tree_int2_to_string(Info, ParseTreeInt2) = Str :-
State0 = string.builder.init,
mercury_format_parse_tree_int2(Info, string.builder.handle, ParseTreeInt2,
State0, State),
Str = string.builder.to_string(State).
parse_tree_int3_to_string(Info, ParseTreeInt3) = Str :-
State0 = string.builder.init,
mercury_format_parse_tree_int3(Info, string.builder.handle, ParseTreeInt3,
State0, State),
Str = string.builder.to_string(State).
%---------------------------------------------------------------------------%
mercury_format_parse_tree_int0(Info, S, ParseTreeInt0, !U) :-
ParseTreeInt0 = parse_tree_int0(ModuleName, _ModuleContext,
MaybeVersionNumbers, InclMap,
ImportUseMap, IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, IntPromises,
ImpTypeClasses, ImpInstances, ImpPredDecls, ImpModeDecls,
ImpDeclPragmas, ImpDeclMarkers, 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_format_module_decl(S, "module", ModuleName, !U),
mercury_format_maybe_module_version_numbers(S, ModuleName,
MaybeVersionNumbers, !U),
mercury_format_section_marker(S, ms_interface, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
IntIncls, !U),
set.foldl(mercury_format_module_decl(S, "import_module"),
IntImports, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
IntUses, !U),
set.foldl(mercury_format_fim_spec(S), IntFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
IntTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
IntInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
IntModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
list.sort(IntTypeClasses), !U),
list.foldl(mercury_format_item_abstract_instance(Info, S),
list.sort(IntInstances), !U),
order_pred_and_mode_decls(IntPredDecls, IntModeDecls, IntPredOrModeDecls),
mercury_format_pred_or_mode_decls(Info, print_name_only, S,
IntPredOrModeDecls, !U),
list.foldl(mercury_format_item_decl_pragma(Info, S),
list.sort(IntDeclPragmas), !U),
list.foldl(mercury_format_item_decl_marker(S),
list.sort(IntDeclMarkers), !U),
list.foldl(mercury_format_item_promise(Info, S),
list.sort(IntPromises), !U),
( 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 = [],
ImpDeclMarkers = [],
ImpPromises = []
then
true
else
mercury_format_section_marker(S, ms_implementation, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
ImpIncls, !U),
set.foldl(mercury_format_module_decl(S, "import_module"),
ImpImports, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
ImpUses, !U),
set.foldl(mercury_format_fim_spec(S), ImpFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
ImpTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
ImpInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
ImpModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
list.sort(ImpTypeClasses), !U),
list.foldl(mercury_format_item_abstract_instance(Info, S),
list.sort(ImpInstances), !U),
order_pred_and_mode_decls(ImpPredDecls, ImpModeDecls,
ImpPredOrModeDecls),
mercury_format_pred_or_mode_decls(Info, print_name_only, S,
ImpPredOrModeDecls, !U),
list.foldl(mercury_format_item_foreign_enum(Info, S),
ImpForeignEnums, !U),
list.foldl(mercury_format_item_decl_pragma(Info, S),
list.sort(ImpDeclPragmas), !U),
list.foldl(mercury_format_item_decl_marker(S),
list.sort(ImpDeclMarkers), !U),
list.foldl(mercury_format_item_promise(Info, S),
list.sort(ImpPromises), !U)
).
mercury_format_parse_tree_int1(Info, S, ParseTreeInt1, !U) :-
ParseTreeInt1 = parse_tree_int1(ModuleName, _ModuleContext,
MaybeVersionNumbers, InclMap, UseMap, IntFIMSpecs, ImpFIMSpecs,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntPredDecls, IntModeDecls,
IntDeclPragmas, IntDeclMarkers, 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_format_module_decl(S, "module", ModuleName, !U),
mercury_format_maybe_module_version_numbers(S, ModuleName,
MaybeVersionNumbers, !U),
mercury_format_section_marker(S, ms_interface, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
IntIncls, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
IntUses, !U),
set.foldl(mercury_format_fim_spec(S), IntFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
IntTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
IntInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
IntModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
list.sort(IntTypeClasses), !U),
list.foldl(mercury_format_item_abstract_instance(Info, S),
list.sort(IntInstances), !U),
order_pred_and_mode_decls(IntPredDecls, IntModeDecls, IntPredOrModeDecls),
mercury_format_pred_or_mode_decls(Info, print_name_only, S,
IntPredOrModeDecls, !U),
list.foldl(mercury_format_item_decl_pragma(Info, S),
list.sort(IntDeclPragmas), !U),
list.foldl(mercury_format_item_decl_marker(S),
list.sort(IntDeclMarkers), !U),
list.foldl(mercury_format_item_promise(Info, S),
list.sort(IntPromises), !U),
map.foldl_values(mercury_format_item_type_repn(Info, S),
IntTypeRepnMap, !U),
( if
set.is_empty(ImpIncls),
set.is_empty(ImpUses),
set.is_empty(ImpFIMSpecs),
ImpTypeDefns = [],
ImpForeignEnums = [],
ImpTypeClasses = []
then
true
else
mercury_format_section_marker(S, ms_implementation, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
ImpIncls, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
ImpUses, !U),
set.foldl(mercury_format_fim_spec(S), ImpFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
ImpTypeDefns, !U),
list.foldl(mercury_format_item_foreign_enum(Info, S),
ImpForeignEnums, !U),
list.foldl(mercury_format_item_abstract_typeclass(Info, S),
list.sort(ImpTypeClasses), !U)
).
mercury_format_parse_tree_int2(Info, S, ParseTreeInt2, !U) :-
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_format_module_decl(S, "module", ModuleName, !U),
mercury_format_maybe_module_version_numbers(S, ModuleName,
MaybeVersionNumbers, !U),
mercury_format_section_marker(S, ms_interface, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
IntIncls, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
IntUses, !U),
set.foldl(mercury_format_fim_spec(S), IntFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
IntTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S),
IntInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S),
IntModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S),
list.sort(IntTypeClasses), !U),
list.foldl(mercury_format_item_abstract_instance(Info, S),
list.sort(IntInstances), !U),
map.foldl_values(mercury_format_item_type_repn(Info, S),
IntTypeRepnMap, !U),
% 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_format_section_marker(S, ms_implementation, !U),
set.foldl(mercury_format_module_decl(S, "use_module"),
ImpUses, !U),
set.foldl(mercury_format_fim_spec(S), ImpFIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S),
ImpTypeDefns, !U)
).
mercury_format_parse_tree_int3(Info, S, ParseTreeInt3, !U) :-
ParseTreeInt3 = parse_tree_int3(ModuleName, _ModuleContext,
IntInclMap, IntImportMap,
TypeCtorCheckedMap, InstCtorCheckedMap, ModeCtorCheckedMap,
IntTypeClasses, IntInstances, IntTypeRepnMap),
InclMap = coerce(IntInclMap),
include_map_to_int_imp_modules(InclMap, IntInclModules, ImpInclModules),
expect(set.is_empty(ImpInclModules), $pred, "ImpInclModules not empty"),
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_format_module_decl(S, "module", ModuleName, !U),
mercury_format_section_marker(S, ms_interface, !U),
set.foldl(mercury_format_module_decl(S, "include_module"),
IntInclModules, !U),
list.foldl(mercury_format_module_decl(S, "import_module"),
map.sorted_keys(IntImportMap), !U),
list.foldl(mercury_format_item_type_defn(Info, S), IntTypeDefns, !U),
list.foldl(mercury_format_item_inst_defn(Info, S), IntInstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S), IntModeDefns, !U),
list.foldl(mercury_format_item_abstract_typeclass(Info, S),
list.sort(IntTypeClasses), !U),
list.foldl(mercury_format_item_abstract_instance(Info, S),
list.sort(IntInstances), !U),
map.foldl_values(mercury_format_item_type_repn(Info, S),
IntTypeRepnMap, !U).
%---------------------------------------------------------------------------%
mercury_output_parse_tree_plain_opt(Info, Stream, ParseTree, !IO) :-
mercury_format_parse_tree_plain_opt(Info, Stream, ParseTree, !IO).
mercury_output_parse_tree_trans_opt(Info, Stream, ParseTree, !IO) :-
mercury_format_parse_tree_trans_opt(Info, Stream, ParseTree, !IO).
%---------------------------------------------------------------------------%
mercury_format_parse_tree_plain_opt(Info, S, ParseTree, !U) :-
ParseTree = parse_tree_plain_opt(ModuleName, _Context,
UseMap, FIMSpecs, TypeDefns, ForeignEnums,
InstDefns, ModeDefns, TypeClasses, Instances,
PredDecls, ModeDecls, Clauses, ForeignProcs, Promises,
DeclMarkers, ImplMarkers, TypeSpecs, UnusedArgs, Terms, Term2s,
Exceptions, Trailings, MMTablings, Sharings, Reuses),
Lang = get_output_lang(Info),
add_string("% .opt file\n", S, !U),
mercury_format_module_decl(S, "module", ModuleName, !U),
list.foldl(mercury_format_module_decl(S, "use_module"),
map.keys(UseMap), !U),
set.foldl(mercury_format_fim_spec(S), FIMSpecs, !U),
list.foldl(mercury_format_item_type_defn(Info, S), TypeDefns, !U),
list.foldl(mercury_format_item_foreign_enum(Info, S),
ForeignEnums, !U),
list.foldl(mercury_format_item_inst_defn(Info, S), InstDefns, !U),
list.foldl(mercury_format_item_mode_defn(Info, S), ModeDefns, !U),
list.foldl(mercury_format_item_typeclass(Info, S), TypeClasses, !U),
list.foldl(mercury_format_item_instance(Info, S), Instances, !U),
% 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_format_item_pred_decl(Lang, VarNamePrintPredDecl, S),
PredDecls, !U),
list.foldl(mercury_format_item_mode_decl(Info, S), ModeDecls, !U),
list.foldl(mercury_format_item_decl_marker(S),
coerce(DeclMarkers), !U),
list.foldl(mercury_format_item_impl_marker(S),
coerce(ImplMarkers), !U),
list.foldl(mercury_format_pragma_type_spec(S, Lang), TypeSpecs, !U),
list.foldl(mercury_format_item_clause(Info, S), Clauses, !U),
list.foldl(mercury_format_item_foreign_proc(S, Lang), ForeignProcs, !U),
list.foldl(mercury_format_item_promise(Info, S), Promises, !U),
maybe_format_block_start_blank_line(S, UnusedArgs, !U),
list.foldl(mercury_format_pragma_unused_args(S), UnusedArgs, !U),
maybe_format_block_start_blank_line(S, Terms, !U),
list.foldl(mercury_format_pragma_termination(S, Lang), Terms, !U),
maybe_format_block_start_blank_line(S, Term2s, !U),
list.foldl(mercury_format_pragma_termination2(S, Lang), Term2s, !U),
maybe_format_block_start_blank_line(S, Exceptions, !U),
list.foldl(mercury_format_pragma_exceptions(S), Exceptions, !U),
maybe_format_block_start_blank_line(S, Trailings, !U),
list.foldl(mercury_format_pragma_trailing(S), Trailings, !U),
maybe_format_block_start_blank_line(S, MMTablings, !U),
list.foldl(mercury_format_pragma_mm_tabling(S), MMTablings, !U),
maybe_format_block_start_blank_line(S, Sharings, !U),
list.foldl(mercury_format_pragma_struct_sharing(S, Lang), Sharings, !U),
maybe_format_block_start_blank_line(S, Reuses, !U),
list.foldl(mercury_format_pragma_struct_reuse(S, Lang), Reuses, !U).
mercury_format_parse_tree_trans_opt(Info, S, ParseTree, !U) :-
ParseTree = parse_tree_trans_opt(ModuleName, _Context,
Terms, Term2s, Exceptions, Trailings, MMTablings, Sharings, Reuses),
Lang = get_output_lang(Info),
add_string("% .trans_opt file\n", S, !U),
mercury_format_module_decl(S, "module", ModuleName, !U),
maybe_format_block_start_blank_line(S, Terms, !U),
list.foldl(mercury_format_pragma_termination(S, Lang), Terms, !U),
maybe_format_block_start_blank_line(S, Term2s, !U),
list.foldl(mercury_format_pragma_termination2(S, Lang), Term2s, !U),
maybe_format_block_start_blank_line(S, Exceptions, !U),
list.foldl(mercury_format_pragma_exceptions(S), Exceptions, !U),
maybe_format_block_start_blank_line(S, Trailings, !U),
list.foldl(mercury_format_pragma_trailing(S), Trailings, !U),
maybe_format_block_start_blank_line(S, MMTablings, !U),
list.foldl(mercury_format_pragma_mm_tabling(S), MMTablings, !U),
maybe_format_block_start_blank_line(S, Sharings, !U),
list.foldl(mercury_format_pragma_struct_sharing(S, Lang), Sharings, !U),
maybe_format_block_start_blank_line(S, Reuses, !U),
list.foldl(mercury_format_pragma_struct_reuse(S, Lang), Reuses, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_maybe_module_version_numbers(S::in, module_name::in,
maybe_version_numbers::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_maybe_module_version_numbers(S, ModuleName,
MaybeVersionNumbers, !U) :-
(
MaybeVersionNumbers = no_version_numbers
;
MaybeVersionNumbers = version_numbers(VersionNumbers),
mercury_format_module_version_numbers(S, ModuleName,
VersionNumbers, !U)
).
:- pred mercury_format_module_version_numbers(S::in, module_name::in,
module_item_version_numbers::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_module_version_numbers(S, ModuleName,
ModuleItemVersionNumbers, !U) :-
string.format(":- 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))],
Str),
add_string(Str, S, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_module_components(merc_out_info::in,
S::in, maybe(module_section)::in, list(module_component)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_module_components(_, _, _, [], !U).
mercury_format_module_components(Info, S, MaybePrevSectionKind,
[Component | Components], !U) :-
(
Component = mc_section(_, SectionKind, _SectionContext,
InclsCord, AvailsCord, FIMsCord, ItemsCord),
mercury_format_section_marker(S, SectionKind, !U),
list.foldl(mercury_format_item_include(Info, S),
cord.list(InclsCord), !U),
list.foldl(mercury_format_item_avail(Info, S),
cord.list(AvailsCord), !U),
list.foldl(mercury_format_item_foreign_import_module(S),
cord.list(FIMsCord), !U),
mercury_format_items(Info, S, cord.list(ItemsCord), !U),
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_format_section_marker(S, SectionKind, !U)
)
;
Lang = output_debug,
mercury_format_section_marker(S, SectionKind, !U),
(
SectionKind = ms_interface,
add_string("% nested submodule in interface\n", S, !U)
;
SectionKind = ms_implementation,
add_string("% nested submodule in implementation\n", S, !U)
)
),
mercury_format_parse_tree_src(Info, S, SubParseTree, !U),
MaybeCurSectionKind = MaybePrevSectionKind
),
mercury_format_module_components(Info, S, MaybeCurSectionKind,
Components, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_section_marker(S::in, module_section::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_section_marker(S, Section, !U) :-
(
Section = ms_interface,
add_string(":- interface.\n", S, !U)
;
Section = ms_implementation,
add_string(":- implementation.\n", S, !U)
).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_include(merc_out_info::in, S::in, item_include::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_include(Info, S, ItemInclude, !U) :-
ItemInclude = item_include(ModuleName, Context, _SeqNum),
Decl = "include_module",
maybe_format_line_number(Info, Context, S, !U),
mercury_format_module_decl(S, Decl, ModuleName, !U).
:- pred mercury_format_item_avail(merc_out_info::in, S::in, item_avail::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_avail(Info, S, Avail, !U) :-
(
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_format_line_number(Info, Context, S, !U),
mercury_format_module_decl(S, Decl, ModuleName, !U).
mercury_output_module_decl(Stream, Decl, ModuleName, !IO) :-
mercury_format_module_decl(Stream, Decl, ModuleName, !IO).
mercury_format_module_decl(S, Decl, ModuleName, !U) :-
ModuleNameStr = mercury_bracketed_sym_name_to_string(ModuleName),
string.format(":- %s %s.\n", [s(Decl), s(ModuleNameStr)], DeclStr),
add_string(DeclStr, S, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_items(merc_out_info::in, S::in, list(item)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_items(_, _, [], !U).
mercury_format_items(Info, S, [Item | Items], !U) :-
mercury_format_item(Info, S, Item, !U),
mercury_format_items(Info, S, Items, !U).
mercury_format_item(Info, S, Item, !U) :-
(
Item = item_type_defn(ItemTypeDefn),
mercury_format_item_type_defn(Info, S, ItemTypeDefn, !U)
;
Item = item_inst_defn(ItemInstDefn),
mercury_format_item_inst_defn(Info, S, ItemInstDefn, !U)
;
Item = item_mode_defn(ItemModeDefn),
mercury_format_item_mode_defn(Info, S, ItemModeDefn, !U)
;
Item = item_pred_decl(ItemPredDecl),
mercury_format_item_pred_decl_mu_mc(Info, print_name_only, S,
ItemPredDecl, !U)
;
Item = item_mode_decl(ItemModeDecl),
mercury_format_item_mode_decl(Info, S, ItemModeDecl, !U)
;
Item = item_clause(ItemClause),
mercury_format_item_clause(Info, S, ItemClause, !U)
;
Item = item_foreign_proc(ItemForeignProc),
mercury_format_item_foreign_proc(S, get_output_lang(Info),
ItemForeignProc, !U)
;
Item = item_foreign_enum(ItemForeignEnum),
mercury_format_item_foreign_enum(Info, S, ItemForeignEnum, !U)
;
Item = item_foreign_export_enum(ItemForeignExportEnum),
mercury_format_item_foreign_export_enum(Info, S,
ItemForeignExportEnum, !U)
;
Item = item_decl_pragma(ItemDeclPragma),
mercury_format_item_decl_pragma(Info, S, ItemDeclPragma, !U)
;
Item = item_decl_marker(ItemDeclPragma),
mercury_format_item_decl_marker(S, ItemDeclPragma, !U)
;
Item = item_impl_pragma(ItemImplPragma),
mercury_format_item_impl_pragma(Info, S, ItemImplPragma, !U)
;
Item = item_impl_marker(ItemImplPragma),
mercury_format_item_impl_marker(S, ItemImplPragma, !U)
;
Item = item_generated_pragma(ItemGenPragma),
mercury_format_item_generated_pragma(Info, S, ItemGenPragma, !U)
;
Item = item_promise(ItemPromise),
mercury_format_item_promise(Info, S, ItemPromise, !U)
;
Item = item_typeclass(ItemTypeClass),
mercury_format_item_typeclass(Info, S, ItemTypeClass, !U)
;
Item = item_instance(ItemInstance),
mercury_format_item_instance(Info, S, ItemInstance, !U)
;
Item = item_initialise(ItemInitialise),
mercury_format_item_initialise(Info, S, ItemInitialise, !U)
;
Item = item_finalise(ItemFinalise),
mercury_format_item_finalise(Info, S, ItemFinalise, !U)
;
Item = item_mutable(ItemMutable),
mercury_format_item_mutable(Info, S, ItemMutable, !U)
;
Item = item_type_repn(ItemTypeRepn),
mercury_format_item_type_repn(Info, S, ItemTypeRepn, !U)
).
%---------------------------------------------------------------------------%
:- pred mercury_format_pred_or_mode_decls(merc_out_info::in,
var_name_print::in, S::in, list(pred_or_mode_decl_item)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_pred_or_mode_decls(_, _, _, [], !U).
mercury_format_pred_or_mode_decls(Info, VarNamePrint, S, [Item | Items], !U) :-
mercury_format_pred_or_mode_decl(Info, VarNamePrint, S, Item, !U),
mercury_format_pred_or_mode_decls(Info, VarNamePrint, S, Items, !U).
:- pred mercury_format_pred_or_mode_decl(merc_out_info::in, var_name_print::in,
S::in, pred_or_mode_decl_item::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_pred_or_mode_decl(Info, VarNamePrint, S, Item, !U) :-
(
Item = pomd_pred(ItemPredDecl),
mercury_format_item_pred_decl_mu_mc(Info, VarNamePrint, S,
ItemPredDecl, !U)
;
Item = pomd_mode(ItemModeDecl),
mercury_format_item_mode_decl(Info, S, ItemModeDecl, !U)
).
%---------------------------------------------------------------------------%
mercury_format_item_type_defn(Info, S, ItemTypeDefn, !U) :-
% 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_format_line_number(Info, Context, S, !U),
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(_)
),
add_string(":- type ", S, !U)
;
DetailsAbstract = abstract_solver_type,
add_string(":- solver type ", S, !U)
),
mercury_format_term_nq_vs(TypeVarSet, print_name_only,
next_to_graphic_token, TypeTerm, S, !U),
(
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_format_where_abstract_enum_type(S, NumBits, !U)
;
( 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_format_where_abstract_subtype(S, SuperTypeCtor, !U)
;
( DetailsAbstract = abstract_type_general
; DetailsAbstract = abstract_solver_type
)
),
add_string(".\n", S, !U)
;
TypeDefn = parse_tree_eqv_type(DetailsEqv),
DetailsEqv = type_details_eqv(EqvType),
add_string(":- type ", S, !U),
mercury_format_term_vs(TypeVarSet, print_name_only, TypeTerm, S, !U),
add_string(" == ", S, !U),
mercury_format_type(TypeVarSet, print_name_only, EqvType, S, !U),
add_string(".\n", S, !U)
;
TypeDefn = parse_tree_du_type(DetailsDu),
DetailsDu = type_details_du(OoMCtors, MaybeCanonical, MaybeDirectArgs),
add_string(":- type ", S, !U),
mercury_format_term_vs(TypeVarSet, print_name_only, TypeTerm, S, !U),
OoMCtors = one_or_more(HeadCtor, TailCtors),
mercury_format_ctors(TypeVarSet, yes, HeadCtor, TailCtors, S, !U),
mercury_format_where_attributes(Info, TypeVarSet, maybe.no,
MaybeCanonical, MaybeDirectArgs, S, !U),
add_string(".\n", S, !U)
;
TypeDefn = parse_tree_sub_type(DetailsDu),
DetailsDu = type_details_sub(SuperType, OoMCtors),
add_string(":- type ", S, !U),
mercury_format_term_vs(TypeVarSet, print_name_only, TypeTerm, S, !U),
add_string(" =< ", S, !U),
mercury_format_type(TypeVarSet, print_name_only, SuperType, S, !U),
OoMCtors = one_or_more(HeadCtor, TailCtors),
mercury_format_ctors(TypeVarSet, yes, HeadCtor, TailCtors, S, !U),
add_string(".\n", S, !U)
;
TypeDefn = parse_tree_solver_type(DetailsSolver),
DetailsSolver =
type_details_solver(SolverTypeDetails, MaybeCanonical),
add_string(":- solver type ", S, !U),
mercury_format_term_vs(TypeVarSet, print_name_only, TypeTerm, S, !U),
mercury_format_where_attributes(Info, TypeVarSet,
yes(SolverTypeDetails), MaybeCanonical, maybe.no, S, !U),
add_string(".\n", S, !U)
;
TypeDefn = parse_tree_foreign_type(DetailsForeign),
DetailsForeign = type_details_foreign(ForeignType, MaybeCanonical,
foreign_type_assertions(Assertions)),
add_string(":- pragma foreign_type(", S, !U),
(
ForeignType = c(_),
add_string("c, ", S, !U)
;
ForeignType = java(_),
add_string("java, ", S, !U)
;
ForeignType = csharp(_),
add_string("csharp, ", S, !U)
),
mercury_format_term_vs(TypeVarSet, print_name_only, TypeTerm, S, !U),
add_string(", \"", S, !U),
(
ForeignType = c(c_type(ForeignTypeStr))
;
ForeignType = java(java_type(ForeignTypeStr))
;
ForeignType = csharp(csharp_type(ForeignTypeStr))
),
add_string(ForeignTypeStr, S, !U),
add_string("\"", S, !U),
set.to_sorted_list(Assertions, AssertionsList),
(
AssertionsList = []
;
AssertionsList = [_ | _],
AssertionStrs =
list.map(foreign_type_assertion_to_string, AssertionsList),
AssertionsStr = string.join_list(", ", AssertionStrs),
add_string(", [", S, !U),
add_string(AssertionsStr, S, !U),
add_string("]", S, !U)
),
add_string(")", S, !U),
mercury_format_where_attributes(Info, TypeVarSet, no,
MaybeCanonical, no, S, !U),
add_string(".\n", S, !U)
).
%---------------------%
%
% Predicates needed to output more than one kind of type.
%
mercury_format_where_attributes(Info, TypeVarSet, MaybeSolverTypeDetails,
MaybeCanonical, MaybeDirectArgs, S, !U) :-
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
add_string("\n where\n", S, !U),
(
MaybeSolverTypeDetails = yes(SolverTypeDetails),
mercury_format_solver_type_details(Info, S, TypeVarSet,
SolverTypeDetails, !U),
(
Lines = []
;
Lines = [_ | _],
add_string(",\n", S, !U)
)
;
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),
add_string(AllLines, S, !U)
)
).
:- pred mercury_format_solver_type_details(merc_out_info::in,
S::in, tvarset::in, solver_type_details::in, U::di, U::uo) is det
<= pt_output(S, U).
mercury_format_solver_type_details(Info, S, TypeVarSet, Details, !U) :-
Details = solver_type_details(RepresentationType, GroundInst,
AnyInst, MutableInfos),
add_string(" representation is ", S, !U),
mercury_format_type(TypeVarSet, print_name_only, RepresentationType,
S, !U),
Lang = get_output_lang(Info),
varset.init(EmptyInstVarSet),
add_string(",\n ground is ", S, !U),
mercury_format_inst(Lang, EmptyInstVarSet, GroundInst, S, !U),
add_string(",\n any is ", S, !U),
mercury_format_inst(Lang, EmptyInstVarSet, AnyInst, S, !U),
(
MutableInfos = []
;
MutableInfos = [_ | _],
add_string(",\n constraint_store is [\n ", S, !U),
list.gap_foldl(mercury_format_item_mutable(Info, S),
add_string(",\n ", S), MutableInfos, !U),
add_string("\n ]", S, !U)
).
%---------------------%
%
% Predicates needed to output abstract types.
%
:- pred mercury_format_where_abstract_enum_type(S::in, int::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_where_abstract_enum_type(S, NumBits, !U) :-
add_string("\n\twhere\t", S, !U),
add_string("type_is_abstract_enum(", S, !U),
% XXX TYPE_REPN
% add_string("type_is_representable_in_n_bits(", S, !U),
add_int(NumBits, S, !U),
add_string(")", S, !U).
:- pred mercury_format_where_abstract_subtype(S::in, type_ctor::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_where_abstract_subtype(S, TypeCtor, !U) :-
add_string("\n\twhere\t", S, !U),
add_string("type_is_abstract_subtype(", S, !U),
TypeCtor = type_ctor(SymName, Arity),
mercury_format_sym_name(SymName, S, !U),
add_string("/", S, !U),
add_int(Arity, S, !U),
add_string(")", S, !U).
%---------------------%
%
% Predicates needed to output discriminated union types.
%
:- pred mercury_format_ctors(tvarset::in, bool::in,
constructor::in, list(constructor)::in, S::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_ctors(VarSet, First, HeadCtor, TailCtors, S, !U) :-
(
First = yes,
add_string("\n ---> ", S, !U)
;
First = no,
add_string("\n ; ", S, !U)
),
mercury_format_ctor(VarSet, HeadCtor, S, !U),
(
TailCtors = []
;
TailCtors = [HeadTailCtor | TailTailCtors],
mercury_format_ctors(VarSet, no, HeadTailCtor, TailTailCtors, S, !U)
).
mercury_format_ctor(TVarSet, Ctor, S, !U) :-
% 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),
add_string(ExistConstraintsPrefix, S, !U),
add_string(BracePrefix, S, !U),
(
Args = [],
mercury_format_bracketed_sym_name(unqualified(Name), S, !U),
% This space prevents a terminating full stop from being confused
% as part of the sym_name if the sym_name contains graphical
% characters.
add_string(" ", S, !U)
;
Args = [HeadArg | TailArgs],
mercury_format_sym_name(unqualified(Name), S, !U),
add_string("(", S, !U),
mercury_format_ctor_args(S, TVarSet, HeadArg, TailArgs, !U),
add_string(")", S, !U)
),
add_string(BraceSuffix, S, !U),
add_string(ExistConstraintsSuffix, S, !U).
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_format_ctor_args(S::in, tvarset::in,
constructor_arg::in, list(constructor_arg)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_ctor_args(S, TVarSet, HeadArg, TailArgs, !U) :-
mercury_format_ctor_arg(S, TVarSet, HeadArg, !U),
(
TailArgs = []
;
TailArgs = [HeadTailArg | TailTailArgs],
add_string(", ", S, !U),
mercury_format_ctor_args(S, TVarSet, HeadTailArg, TailTailArgs, !U)
).
:- pred mercury_format_ctor_arg(S::in, tvarset::in, constructor_arg::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_ctor_arg(S, TVarSet, Arg, !U) :-
Arg = ctor_arg(Name, Type, _Context),
mercury_format_ctor_arg_name_prefix(S, Name, !U),
mercury_format_type(TVarSet, print_name_only, Type, S, !U).
:- pred mercury_format_ctor_arg_name_prefix(S::in, maybe(ctor_field_name)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_ctor_arg_name_prefix(_S, no, !U).
mercury_format_ctor_arg_name_prefix(S, yes(FieldName), !U) :-
FieldName = ctor_field_name(Name, _Ctxt),
mercury_format_bracketed_sym_name(Name, S, !U),
add_string(" :: ", S, !U).
%---------------------------------------------------------------------------%
mercury_format_item_inst_defn(Info, S, ItemInstDefn, !U) :-
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_format_line_number(Info, Context, S, !U),
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,
add_string(":- abstract_inst((", S, !U),
mercury_format_term_vs(InstVarSet, print_name_only, InstTerm,
S, !U),
add_string(")).\n", S, !U)
;
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.
add_string(":- inst ", S, !U),
add_string(sym_name_to_string(SymName), S, !U),
(
ArgTerms = []
;
ArgTerms = [HeadArgTerm | TailArgTerms],
add_string("(", S, !U),
mercury_format_comma_separated_terms_vs(InstVarSet,
print_name_only, HeadArgTerm, TailArgTerms, S, !U),
add_string(")", S, !U)
)
else
% No it isn't, so print the extra parentheses.
add_string(":- inst (", S, !U),
mercury_format_term_vs(InstVarSet, print_name_only, InstTerm,
S, !U),
add_string(")", S, !U)
),
(
MaybeForTypeCtor = no
;
MaybeForTypeCtor = yes(ForTypeCtor),
ForTypeCtor = type_ctor(ForTypeCtorSymName, ForTypeCtorArity),
add_string(" for ", S, !U),
mercury_format_sym_name(ForTypeCtorSymName, S, !U),
add_string("/", S, !U),
add_int(ForTypeCtorArity, S, !U)
),
( 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.
add_string("\n", S, !U),
format_bound_inst_being_defined(S, Lang, InstVarSet,
" ---> ", HeadSimpleBI, TailSimpleBIs, !U)
else
% No, so fall back to the less readable but more general syntax.
add_string(" == ", S, !U),
mercury_format_inst(Lang, InstVarSet, Inst, S, !U),
add_string(".\n", S, !U)
)
).
% 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 format_bound_inst_being_defined(S::in,
output_lang::in, inst_varset::in, string::in,
simple_bound_inst::in, list(simple_bound_inst)::in,
U::di, U::uo) is det <= pt_output(S, U).
format_bound_inst_being_defined(S, Lang, InstVarSet, ArrowOrSemi,
HeadBI, TailBIs, !U) :-
HeadBI = simple_bound_functor(Name, ArgInsts),
string.format("%s%s", [s(ArrowOrSemi), s(Name)], InitStr),
add_string(InitStr, S, !U),
(
ArgInsts = []
;
ArgInsts = [_ | _],
add_string("(", S, !U),
mercury_format_inst_list(Lang, InstVarSet, ArgInsts, S, !U),
add_string(")", S, !U)
),
(
TailBIs = [],
add_string(".\n", S, !U)
;
TailBIs = [HeadTailBI | TailTailBIs],
add_string("\n", S, !U),
format_bound_inst_being_defined(S, Lang, InstVarSet,
" ; ", HeadTailBI, TailTailBIs, !U)
).
%---------------------------------------------------------------------------%
mercury_format_item_mode_defn(Info, S, ItemModeDefn, !U) :-
ItemModeDefn = item_mode_defn_info(SymName, InstParams,
MaybeAbstractModeDefn, VarSet, Context, _SeqNum),
maybe_unqualify_sym_name(Info, SymName, UnQualSymName),
maybe_format_line_number(Info, Context, S, !U),
Lang = get_output_lang(Info),
mercury_format_mode_defn(Lang, VarSet, Context, UnQualSymName, InstParams,
MaybeAbstractModeDefn, S, !U).
% 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
<= pt_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 <= pt_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_format_item_pred_decl_mu_mc(merc_out_info::in,
var_name_print::in, S::in, item_pred_decl_info::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_pred_decl_mu_mc(Info, VarNamePrint, S,
ItemPredDecl0, !U) :-
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_format_line_number(Info, ItemPredDecl ^ pf_context, S, !U),
Lang = get_output_lang(Info),
mercury_format_item_pred_decl(Lang, VarNamePrint, S, ItemPredDecl, !U).
mercury_format_item_pred_decl(Lang, VarNamePrint, S, ItemPredDecl, !U) :-
% 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", S, !U)
else
mercury_format_pred_or_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, PredOrFunc, ExistQVars,
PredSymName, TypesAndModes, WithType, WithInst, MaybeDetism,
Purity, Constraints, ":- ", ".\n", ".\n", S, !U)
).
%---------------------------------------------------------------------------%
mercury_format_item_mode_decl(Info, S, ItemModeDecl, !U) :-
% 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_format_line_number(Info, Context, S, !U),
Lang = get_output_lang(Info),
( if
MaybePredOrFunc = yes(pf_function),
% Function mode declarations using `with_type` have the same format
% as predicate mode declarations.
MaybeWithInst = no
then
pred_args_to_func_args(ArgModes, FuncArgModes, ReturnMode),
mercury_format_func_mode_decl(Lang, InstVarSet, PredSymName,
FuncArgModes, ReturnMode, MaybeDetism, S, !U)
else
mercury_format_pred_mode_decl(Lang, InstVarSet, PredSymName,
ArgModes, MaybeWithInst, MaybeDetism, S, !U)
).
%---------------------------------------------------------------------------%
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 <= pt_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 <= pt_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,
S::in, item_foreign_export_enum_info::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_foreign_export_enum(_Info, S, ItemForeignExportEnum, !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 <= pt_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 <= pt_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 <= pt_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_format_item_promise(merc_out_info::in, S::in,
item_promise_info::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_promise(_, S, ItemPromise, !U) :-
% 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,
string.format(":- promise all [%s] ", [s(UnivVarsStr)], PrefixStr)
;
( PromiseType = promise_type_exclusive
; PromiseType = promise_type_exhaustive
; PromiseType = promise_type_exclusive_exhaustive
),
string.format(":- all [%s]\n%s\n",
[s(UnivVarsStr), s(promise_to_string(PromiseType))], PrefixStr)
),
add_string(PrefixStr, S, !U),
add_string("(\n", S, !U),
Indent = 1,
mercury_format_goal(S, VarSet, Indent, Goal, !U),
add_string("\n).\n", S, !U).
%---------------------------------------------------------------------------%
mercury_format_item_typeclass(Info, S, ItemTypeClass, !U) :-
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),
string.format(":- typeclass %s(%s)",
[s(ClassNameStr), s(VarsStr)], DeclStr),
add_string(DeclStr, S, !U),
mercury_format_fundeps_and_prog_constraint_list(VarSet, print_name_only,
FunDeps, Constraints, S, !U),
(
Interface = class_interface_abstract,
add_string(".\n", S, !U)
;
Interface = class_interface_concrete(ClassDecls),
(
ClassDecls = [],
add_string(" where [].\n", S, !U)
;
ClassDecls = [HeadClassDecl | TailClassDecls],
add_string(" where [\n", S, !U),
Lang = get_output_lang(Info),
format_class_decls(S, Lang, print_name_only,
HeadClassDecl, TailClassDecls, !U),
add_string("].\n", S, !U)
)
).
mercury_format_item_abstract_typeclass(Info, S, ItemTypeClass, !U) :-
ItemTypeClass = item_typeclass_info(ClassName0, Vars, Constraints, FunDeps,
class_interface_abstract, 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),
string.format(":- typeclass %s(%s)", [s(ClassNameStr), s(VarsStr)],
StartStr),
add_string(StartStr, S, !U),
mercury_format_fundeps_and_prog_constraint_list(VarSet, print_name_only,
FunDeps, Constraints, S, !U),
add_string(".\n", S, !U).
:- 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 <= pt_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 <= pt_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 format_class_decls(S::in, output_lang::in, var_name_print::in,
class_decl::in, list(class_decl)::in, U::di, U::uo) is det
<= pt_output(S, U).
format_class_decls(S, Lang, VarNamePrint, HeadClassDecl, TailClassDecls, !U) :-
format_class_decl(S, Lang, VarNamePrint, HeadClassDecl, !U),
(
TailClassDecls = [],
add_string("\n", S, !U)
;
TailClassDecls = [HeadTailClassDecl | TailTailClassDecls],
add_string(",\n", S, !U),
format_class_decls(S, Lang, VarNamePrint,
HeadTailClassDecl, TailTailClassDecls, !U)
).
:- pred format_class_decl(S::in, output_lang::in, var_name_print::in,
class_decl::in, U::di, U::uo) is det <= pt_output(S, U).
format_class_decl(S, Lang, VarNamePrint, Decl, !U) :-
add_string("\t", S, !U),
(
Decl = class_decl_pred_or_func(PredOrFuncInfo),
PredOrFuncInfo = class_pred_or_func_info(SymName0, PredOrFunc,
TypesAndModes, WithType, WithInst, MaybeDetism,
TypeVarSet, InstVarSet, ExistQVars, Purity,
Constraints, _Context),
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
SymName = unqualified(unqualify_name(SymName0)),
( 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,
SymName, FuncTypesAndModes, RetTypeAndMode, MaybeDetism,
Purity, Constraints, "", ",\n\t", "", S, !U)
else
mercury_format_pred_or_func_decl(Lang, VarNamePrint,
TypeVarSet, InstVarSet, PredOrFunc, ExistQVars,
SymName, TypesAndModes, WithType, WithInst, MaybeDetism,
Purity, Constraints, "", ",\n\t", "", S, !U)
)
;
Decl = class_decl_mode(ModeInfo),
ModeInfo = class_mode_info(SymName0, PredOrFunc, Modes,
WithInst, MaybeDetism, InstVarSet, _Context),
% The module name is implied by the qualifier of the
% `:- typeclass declaration'.
SymName = unqualified(unqualify_name(SymName0)),
( 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_gen(Lang, InstVarSet,
SymName, FuncModes, RetMode, MaybeDetism, "", "", S, !U)
else
mercury_format_pred_or_func_mode_decl_gen(Lang, InstVarSet,
SymName, Modes, WithInst, MaybeDetism, "", "", S, !U)
)
).
%---------------------------------------------------------------------------%
mercury_format_item_instance(_Info, S, ItemInstance, !U) :-
ItemInstance = item_instance_info(_ClassName, _Types, _OriginalTypes,
_Constraints, Body, _VarSet, _InstanceModuleName, _Context, _SeqNum),
HeaderStr = mercury_instance_header_to_string(ItemInstance),
(
Body = instance_body_abstract,
string.format("%s.\n", [s(HeaderStr)], DeclStr),
add_string(DeclStr, S, !U)
;
Body = instance_body_concrete(Methods),
(
Methods = [],
string.format("%s where [].\n", [s(HeaderStr)], DeclStr),
add_string(DeclStr, S, !U)
;
Methods = [HeadMethod | TailMethods],
string.format("%s where [\n", [s(HeaderStr)], DeclStartStr),
add_string(DeclStartStr, S, !U),
mercury_format_instance_methods(S, HeadMethod, TailMethods, !U),
add_string("].\n", S, !U)
)
).
item_abstract_instance_to_string(Info, ItemAbstractInstance) = Str :-
State0 = string.builder.init,
mercury_format_item_abstract_instance(Info, string.builder.handle,
ItemAbstractInstance, State0, State),
Str = string.builder.to_string(State).
mercury_format_item_abstract_instance(_Info, S, ItemAbstractInstance, !U) :-
HeaderStr =
mercury_instance_header_to_string(coerce(ItemAbstractInstance)),
string.format("%s.\n", [s(HeaderStr)], DeclStr),
add_string(DeclStr, S, !U).
:- func mercury_instance_header_to_string(item_instance_info) = string.
mercury_instance_header_to_string(ItemInstance) = Str :-
% XXX When prettyprinting a Mercury module, we want to print the original
% types. When generating interface files, we want to print the
% equiv-type-expanded types. We do the latter.
% XXX We could add an argument, or a field to merc_out_info,
% that says which kind of file we are generating.
ItemInstance = item_instance_info(ClassName, Types, _OriginalTypes,
Constraints, _Body, VarSet, _InstanceModuleName, _Context, _SeqNum),
ClassNameStr = mercury_sym_name_to_string(ClassName),
TypeStrs =
list.map(mercury_type_to_string(VarSet, print_name_only), Types),
TypesStr = string.join_list(", ", TypeStrs),
ConstraintsStr = mercury_prog_constraint_list_to_string(VarSet,
print_name_only, "<=", Constraints),
( if
( ops.mercury_op_table_is_op(ClassNameStr)
; not is_all_alnum_or_underscore(ClassNameStr)
)
then
% We put an extra set of brackets around the class name
% if the name is an operator or contains non-alphanumeric characters.
string.format(":- instance (%s(%s))%s",
[s(ClassNameStr), s(TypesStr), s(ConstraintsStr)], Str)
else
string.format(":- instance %s(%s)%s",
[s(ClassNameStr), s(TypesStr), s(ConstraintsStr)], Str)
).
:- pred mercury_format_instance_methods(S::in,
instance_method::in, list(instance_method)::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_instance_methods(S, HeadMethod, TailMethods, !U) :-
mercury_format_instance_method(HeadMethod, S, !U),
(
TailMethods = [],
add_string("\n", S, !U)
;
TailMethods = [HeadTailMethod | TailTailMethods],
add_string(",\n", S, !U),
mercury_format_instance_methods(S, HeadTailMethod, TailTailMethods, !U)
).
mercury_format_instance_method(Method, S, !U) :-
Method = instance_method(MethodId, Defn, _Context),
MethodId = pred_pf_name_arity(PredOrFunc, MethodSymName, UserArity),
UserArity = user_arity(UserArityInt),
(
Defn = instance_proc_def_name(PredName),
PFStr = pred_or_func_to_str(PredOrFunc),
MethodSymNameStr = mercury_bracketed_sym_name_to_string_ngt(
next_to_graphic_token, MethodSymName),
PredNameStr = mercury_bracketed_sym_name_to_string(PredName),
string.format("\t%s(%s/%d) is %s",
[s(PFStr), s(MethodSymNameStr), i(UserArityInt), s(PredNameStr)],
DeclStr),
add_string(DeclStr, S, !U)
;
Defn = instance_proc_def_clauses(ItemsCord),
Items = cord.list(ItemsCord),
% XXX should we output the term contexts?
add_string("\t(", S, !U),
add_list(mercury_format_instance_method_clause(MethodSymName),
"),\n\t(", Items, S, !U),
add_string(")", S, !U)
).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_initialise(merc_out_info::in, S::in,
item_initialise_info::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_initialise(_, S, ItemInitialise, !IO) :-
ItemInitialise = item_initialise_info(PredSymName, UserArity, _, _, _),
PredSymNameStr = mercury_bracketed_sym_name_to_string(PredSymName),
UserArity = user_arity(UserArityInt),
string.format(":- initialise %s/%d.\n",
[s(PredSymNameStr), i(UserArityInt)], DeclStr),
add_string(DeclStr, S, !IO).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_finalise(merc_out_info::in, S::in,
item_finalise_info::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_finalise(_, S, ItemFinalise, !IO) :-
ItemFinalise = item_finalise_info(PredSymName, UserArity, _, _, _),
PredSymNameStr = mercury_bracketed_sym_name_to_string(PredSymName),
UserArity = user_arity(UserArityInt),
string.format(":- finalise %s/%d.\n",
[s(PredSymNameStr), i(UserArityInt)], DeclStr),
add_string(DeclStr, S, !IO).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_mutable(merc_out_info::in, S::in,
item_mutable_info::in, U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_mutable(Info, S, ItemMutable, !U) :-
ItemMutable = item_mutable_info(Name, _OrigType, Type, _OrigInst, Inst,
InitTerm, MutVarSet, Attrs, _Context, _SeqNum),
add_string(":- mutable(", S, !U),
add_string(Name, S, !U),
add_string(", ", S, !U),
mercury_format_type(varset.init, print_name_only, Type, S, !U),
add_string(", ", S, !U),
% See the comments for read_mutable_decl for the reason we _must_ use
% MutVarSet here.
mercury_format_term_vs(MutVarSet, print_name_only, InitTerm, S, !U),
add_string(", ", S, !U),
Lang = get_output_lang(Info),
mercury_format_inst(Lang, varset.init, Inst, S, !U),
add_string(", ", S, !U),
add_string(string.string(Attrs), S, !U),
add_string(").\n", S, !U).
%---------------------------------------------------------------------------%
:- pred mercury_format_item_foreign_import_module(S::in, item_fim::in,
U::di, U::uo) is det <= pt_output(S, U).
mercury_format_item_foreign_import_module(S, ItemFIM, !U) :-
ItemFIM = item_fim(Lang, ModuleName, _Context, _SeqNum),
FIMSpec = fim_spec(Lang, ModuleName),
mercury_format_fim_spec(S, FIMSpec, !U).
mercury_output_fim_spec(Stream, FIMSpec, !IO) :-
mercury_format_fim_spec(Stream, FIMSpec, !IO).
mercury_format_fim_spec(S, FIMSpec, !U) :-
FIMSpec = fim_spec(Lang, ModuleName),
add_string(":- pragma foreign_import_module(", S, !U),
mercury_format_foreign_language_string(Lang, S, !U),
add_string(", ", S, !U),
mercury_format_bracketed_sym_name_ngt(not_next_to_graphic_token,
ModuleName, S, !U),
add_string(").\n", S, !U).
%---------------------------------------------------------------------------%
maybe_format_block_start_blank_line(S, Items, !U) :-
(
Items = []
;
Items = [_ | _],
add_string("\n", S, !U)
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.parse_tree_out.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink