[m-rev.] for review: Don't use exceptions internally for foreign include file errors.
Peter Wang
novalazy at gmail.com
Fri Aug 17 17:14:12 AEST 2018
Use normal return values to signal errors internally if a file
referenced by a `include_file' in a foreign_decl or foreign_code
declaration is missing or there is some error reading from it,
instead of throwing and catching an exception. This allows a compiler
built in a deep profiling grade to continue without aborting.
compiler/file_util.m
Make the closure argument to output_to_file return a list of error
strings, and make output_to_file return a boolean indicating if
there were any errors.
Delete output_to_file_return_result as it was only used to implement
output_to_file.
Make write_include_file_contents, write_include_file_contents_cur_stream
return an error instead of throwing an exception if the include file
could not be opened or copied to the output stream.
Delete the include_file_error type. Don't throw or catch exceptions
of that type.
compiler/compiler_util.m:
Add helper predicate maybe_is_error.
compiler/elds_to_erlang.m
compiler/llds_out_file.m
compiler/mlds_to_c_file.m
compiler/mlds_to_cs_file.m
compiler/mlds_to_java_file.m
Return a list of errors when writing out target code or header
files. Currently the only errors will be due to missing or
unreadable foreign include files.
compiler/export.m
Report errors due to missing or unreachable foreign include files.
Delete the temporary .mh.tmp file if there was an error while
generating it.
---
compiler/compiler_util.m | 11 +++-
compiler/elds_to_erlang.m | 57 ++++++++++--------
compiler/export.m | 42 +++++++++----
compiler/file_util.m | 107 ++++++++++++++++-----------------
compiler/llds_out_file.m | 55 ++++++++++-------
compiler/mlds_to_c_file.m | 111 +++++++++++++++++++++--------------
compiler/mlds_to_cs_file.m | 48 +++++++++------
compiler/mlds_to_java_file.m | 47 +++++++++------
8 files changed, 279 insertions(+), 199 deletions(-)
diff --git a/compiler/compiler_util.m b/compiler/compiler_util.m
index 0024f01ff..312035792 100644
--- a/compiler/compiler_util.m
+++ b/compiler/compiler_util.m
@@ -1,34 +1,40 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2006, 2009-2010 The University of Melbourne.
+% Copyright (C) 2014-2015, 2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: compiler_util.
% Main author: zs.
%
% This module contains code that can be helpful in any compiler module.
%
%-----------------------------------------------------------------------------%
:- module libs.compiler_util.
:- interface.
:- import_module libs.globals.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
:- import_module io.
:- import_module list.
+:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_is_error(maybe_error::in, string::out) is semidet.
%-----------------------------------------------------------------------------%
% This type is useful when defining options and behaviours that may
% raise either an error or a warning. See
% pragma_require_tail_recursion.
%
:- type warning_or_error
---> we_warning
; we_error.
@@ -70,21 +76,24 @@
io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module libs.options.
:- import_module bool.
-:- import_module maybe.
+
+%-----------------------------------------------------------------------------%
+
+maybe_is_error(error(Error), Error).
%-----------------------------------------------------------------------------%
warning_or_error_string(we_warning, "warn").
warning_or_error_string(we_error, "error").
warning_or_error_severity(we_warning, severity_warning).
warning_or_error_severity(we_error, severity_error).
%-----------------------------------------------------------------------------%
diff --git a/compiler/elds_to_erlang.m b/compiler/elds_to_erlang.m
index cc5498fd8..47304a1a3 100644
--- a/compiler/elds_to_erlang.m
+++ b/compiler/elds_to_erlang.m
@@ -46,20 +46,21 @@
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.rtti.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module hlds.pred_table.
:- import_module hlds.status.
:- import_module libs.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.file_names.
:- import_module parse_tree.module_cmds.
:- import_module parse_tree.prog_data.
@@ -103,23 +104,23 @@ output_elds(ModuleInfo, ELDS, Succeeded, !IO) :-
update_interface(Globals, HeaderFileName, !IO)
;
Succeeded = no
)
;
TargetCodeSucceeded = no,
Succeeded = no
).
:- pred output_erl_file(module_info::in, elds::in, string::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
+output_erl_file(ModuleInfo, ELDS, SourceFileName, Errors, !IO) :-
ELDS = elds(ModuleName, Imports, ForeignDecls, ForeignBodies, ProcDefns,
ForeignExportDefns, RttiDefns, InitPreds, FinalPreds),
AddMainWrapper = should_add_main_wrapper(ModuleInfo),
% Output intro.
output_do_no_edit_comment(SourceFileName, !IO),
% Write module annotations.
io.write_string("-module(", !IO),
output_atom(erlang_module_name_to_str(ModuleName), !IO),
@@ -135,21 +136,22 @@ output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
!IO),
io.write_string("]).\n", !IO),
% Useful for debugging.
io.write_string("% -compile(export_all).\n", !IO),
module_info_get_globals(ModuleInfo, Globals),
set.fold(output_include_header_ann(Globals), Imports, !IO),
% Output foreign declarations.
- list.foldl(output_foreign_decl_code(SourceFileName), ForeignDecls, !IO),
+ list.map_foldl(output_foreign_decl_code(SourceFileName),
+ ForeignDecls, ForeignDeclResults, !IO),
% Write directives for mkinit_erl.
ErlangModuleNameStr = erlang_module_name_to_str(ModuleName),
(
InitPreds = []
;
InitPreds = [_ | _],
io.write_string("% REQUIRED_INIT ", !IO),
output_atom(ErlangModuleNameStr, !IO),
io.write_string(":mercury__required_init\n", !IO)
@@ -162,40 +164,45 @@ output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
output_atom(ErlangModuleNameStr, !IO),
io.write_string(":mercury__required_final\n", !IO)
),
EnvVarNames = elds_get_env_var_names(ProcDefns),
set.fold(output_env_var_directive, EnvVarNames, !IO),
% We always write out ENDINIT so that mkinit_erl doesn't scan the whole
% file.
io.write_string("% ENDINIT\n", !IO),
% Output foreign code written in Erlang.
- list.foldl(output_foreign_body_code(SourceFileName), ForeignBodies, !IO),
+ list.map_foldl(output_foreign_body_code(SourceFileName),
+ ForeignBodies, ForeignCodeResults, !IO),
% Output the main wrapper, if any.
(
AddMainWrapper = yes,
io.write_string(main_wrapper_code, !IO)
;
AddMainWrapper = no
),
% XXX there are also user_init_preds generated which aren't used.
maybe_output_required_init_or_final(ModuleInfo, "mercury__required_init",
InitPreds, !IO),
maybe_output_required_init_or_final(ModuleInfo, "mercury__required_final",
FinalPreds, !IO),
% Output function definitions.
list.foldl(output_defn(ModuleInfo), ProcDefns, !IO),
list.foldl(output_foreign_export_defn(ModuleInfo), ForeignExportDefns,
!IO),
- list.foldl(output_rtti_defn(ModuleInfo), RttiDefns, !IO).
+ list.foldl(output_rtti_defn(ModuleInfo), RttiDefns, !IO),
+
+ list.filter_map(maybe_is_error, ForeignDeclResults, ForeignDeclErrors),
+ list.filter_map(maybe_is_error, ForeignCodeResults, ForeignCodeErrors),
+ Errors = ForeignDeclErrors ++ ForeignCodeErrors.
:- pred output_do_no_edit_comment(string::in, io::di, io::uo) is det.
output_do_no_edit_comment(SourceFileName, !IO) :-
library.version(Version, Fullarch),
io.write_strings([
"%\n",
"% Automatically generated from `", SourceFileName, "'\n",
"% by the Mercury compiler,\n",
"% version ", Version, "\n",
@@ -408,50 +415,52 @@ output_env_var_directive(EnvVarName, !IO) :-
output_include_header_ann(Globals, Import, !IO) :-
module_name_to_search_file_name(Globals, ".hrl", Import, HeaderFile, !IO),
io.write_string("-include(""", !IO),
write_with_escaping(in_string, HeaderFile, !IO),
io.write_string(""").\n", !IO).
%-----------------------------------------------------------------------------%
:- pred output_foreign_decl_code(string::in, foreign_decl_code::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
-output_foreign_decl_code(SourceFileName, ForeignDecl, !IO) :-
+output_foreign_decl_code(SourceFileName, ForeignDecl, Res, !IO) :-
ForeignDecl = foreign_decl_code(_Lang, _IsLocal, LiteralOrInclude,
Context),
output_foreign_literal_or_include(SourceFileName, LiteralOrInclude,
- Context, !IO).
+ Context, Res, !IO).
:- pred output_foreign_body_code(string::in, foreign_body_code::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
-output_foreign_body_code(SourceFileName, ForeignBody, !IO) :-
+output_foreign_body_code(SourceFileName, ForeignBody, Res, !IO) :-
ForeignBody = foreign_body_code(_Lang, LiteralOrInclude, Context),
output_foreign_literal_or_include(SourceFileName, LiteralOrInclude,
- Context, !IO).
+ Context, Res, !IO).
:- pred output_foreign_literal_or_include(string::in,
- foreign_literal_or_include::in, context::in, io::di, io::uo) is det.
+ foreign_literal_or_include::in, context::in, maybe_error::out,
+ io::di, io::uo) is det.
output_foreign_literal_or_include(SourceFileName, LiteralOrInclude, Context,
- !IO) :-
+ Res, !IO) :-
(
LiteralOrInclude = floi_literal(Code),
output_file_directive(Context, !IO),
- io.write_string(Code, !IO)
+ io.write_string(Code, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFileName),
make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
output_file_directive(context(IncludePath, 1), !IO),
- write_include_file_contents_cur_stream(IncludePath, !IO)
+ write_include_file_contents_cur_stream(IncludePath, Res, !IO)
),
io.nl(!IO),
reset_file_directive(!IO).
:- pred output_file_directive(context::in, io::di, io::uo) is det.
output_file_directive(context(FileName, LineNr), !IO) :-
io.write_string("-file(""", !IO),
write_with_escaping(in_string, FileName, !IO),
io.write_string(""", ", !IO),
@@ -1350,49 +1359,51 @@ escape("\\^x", 24).
escape("\\^y", 25).
escape("\\^z", 26).
escape("\\'", 39).
escape("\\\"", 34).
escape("\\\\", 92).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- pred output_hrl_file(module_name::in, elds::in, string::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-output_hrl_file(ModuleName, ELDS, SourceFileName, !IO) :-
+output_hrl_file(ModuleName, ELDS, SourceFileName, Errors, !IO) :-
output_do_no_edit_comment(SourceFileName, !IO),
MangledModuleName = sym_name_mangle(ModuleName),
string.to_upper(MangledModuleName, UppercaseModuleName),
string.append(UppercaseModuleName, "_HRL", GuardMacroName),
io.write_strings([
"-ifndef(", GuardMacroName, ").\n",
"-define(", GuardMacroName, ", 1).\n"
], !IO),
ForeignDecls = ELDS ^ elds_foreign_decls,
- list.foldl(output_exported_foreign_decl_code(SourceFileName), ForeignDecls,
- !IO),
+ list.map_foldl(output_exported_foreign_decl_code(SourceFileName),
+ ForeignDecls, ForeignDeclResults, !IO),
+ list.filter_map(maybe_is_error, ForeignDeclResults, Errors),
io.write_string("-endif.\n", !IO).
:- pred output_exported_foreign_decl_code(string::in, foreign_decl_code::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
-output_exported_foreign_decl_code(SourceFileName, ForeignDecl, !IO) :-
+output_exported_foreign_decl_code(SourceFileName, ForeignDecl, Res, !IO) :-
IsLocal = ForeignDecl ^ fdecl_is_local,
(
- IsLocal = foreign_decl_is_local
+ IsLocal = foreign_decl_is_local,
+ Res = ok
;
IsLocal = foreign_decl_is_exported,
- output_foreign_decl_code(SourceFileName, ForeignDecl, !IO)
+ output_foreign_decl_code(SourceFileName, ForeignDecl, Res, !IO)
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- type indent == int.
:- pred nl_indent_line(indent::in, io::di, io::uo) is det.
nl_indent_line(N, !IO) :-
diff --git a/compiler/export.m b/compiler/export.m
index 93ce8b281..8ba7c078b 100644
--- a/compiler/export.m
+++ b/compiler/export.m
@@ -1,14 +1,15 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2012 The University of Melbourne.
+% Copyright (C) 2013-2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: export.m.
% Main author: dgj, juliensf.
%
% This module defines predicates to produce the functions which are
% exported to a foreign language via a `pragma foreign_export' declaration.
%
@@ -88,20 +89,21 @@
:- import_module backend_libs.proc_label.
:- import_module check_hlds.
:- import_module check_hlds.type_util.
:- import_module hlds.arg_info.
:- import_module hlds.code_model.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_llds.
:- import_module hlds.pred_table.
:- import_module hlds.status.
:- import_module libs.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.file_names.
:- import_module parse_tree.module_cmds.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_util.
:- import_module assoc_list.
@@ -790,50 +792,60 @@ produce_header_file(ModuleInfo, ForeignExportDecls, ModuleName, !IO) :-
foreign_export_decls(ForeignDeclCodes, CExportDecls),
list.filter(foreign_decl_code_is_for_lang(lang_c),
ForeignDeclCodes, CForeignDeclCodes),
( if
CExportedEnums = [],
CForeignDeclCodes = []
then
% The two folds below won't output anything.
% There is no point in printing guards around nothing.
- true
+ CForeignDeclCodeResults = []
else
MaybeSetLineNumbers = lookup_line_numbers(Globals,
line_numbers_for_c_headers),
io.write_strings(FileStream, [
"#ifndef ", decl_guard(ModuleName), "\n",
"#define ", decl_guard(ModuleName), "\n"], !IO),
list.foldl(
output_exported_c_enum(FileStream, MaybeSetLineNumbers,
MaybeThisFileName),
CExportedEnums, !IO),
- list.foldl(
+ list.map_foldl(
output_foreign_decl(FileStream, MaybeSetLineNumbers,
MaybeThisFileName, SourceFileName,
yes(foreign_decl_is_exported)),
- CForeignDeclCodes, !IO),
+ CForeignDeclCodes, CForeignDeclCodeResults, !IO),
io.write_string(FileStream, "\n#endif\n", !IO)
),
write_export_decls(FileStream, CExportDecls, !IO),
io.write_strings(FileStream, [
"\n",
"#ifdef __cplusplus\n",
"}\n",
"#endif\n",
"\n",
"#endif /* ", GuardMacroName, " */\n"], !IO),
io.close_output(FileStream, !IO),
- % rename "<ModuleName>.mh.tmp" to "<ModuleName>.mh".
- update_interface(Globals, FileName, !IO)
+
+ list.filter_map(maybe_is_error, CForeignDeclCodeResults, Errors),
+ (
+ Errors = [],
+ % Rename "<ModuleName>.mh.tmp" to "<ModuleName>.mh".
+ update_interface(Globals, FileName, !IO)
+ ;
+ Errors = [_ | _],
+ io.remove_file(FileName ++ ".tmp", _, !IO),
+ % report_error sets the exit status.
+ foldl(report_error, Errors, !IO)
+ )
;
Result = error(_),
io.progname_base("export.m", ProgName, !IO),
io.write_string("\n", !IO),
io.write_string(ProgName, !IO),
io.write_string(": can't open `", !IO),
io.write_string(FileName ++ ".tmp", !IO),
io.write_string("' for output\n", !IO),
io.set_exit_status(1, !IO)
).
@@ -857,60 +869,64 @@ write_export_decls(Stream, [ExportDecl | ExportDecls], !IO) :-
( Lang = lang_csharp
; Lang = lang_java
; Lang = lang_erlang
),
sorry($pred, "foreign languages other than C unimplemented")
),
write_export_decls(Stream, ExportDecls, !IO).
:- pred output_foreign_decl(io.text_output_stream::in,
maybe_set_line_numbers::in, maybe(string)::in, string::in,
- maybe(foreign_decl_is_local)::in, foreign_decl_code::in,
+ maybe(foreign_decl_is_local)::in, foreign_decl_code::in, maybe_error::out,
io::di, io::uo) is det.
output_foreign_decl(Stream, MaybeSetLineNumbers, MaybeThisFileName,
- SourceFileName, MaybeDesiredIsLocal, DeclCode, !IO) :-
+ SourceFileName, MaybeDesiredIsLocal, DeclCode, Res, !IO) :-
DeclCode = foreign_decl_code(Lang, IsLocal, LiteralOrInclude, Context),
expect(unify(Lang, lang_c), $pred, "Lang != lang_c"),
( if
(
MaybeDesiredIsLocal = no
;
MaybeDesiredIsLocal = yes(DesiredIsLocal),
DesiredIsLocal = IsLocal
)
then
output_foreign_literal_or_include(Stream, MaybeSetLineNumbers,
- MaybeThisFileName, SourceFileName, LiteralOrInclude, Context, !IO)
+ MaybeThisFileName, SourceFileName, LiteralOrInclude, Context,
+ Res, !IO)
else
- true
+ Res = ok
).
:- pred output_foreign_literal_or_include(io.text_output_stream::in,
maybe_set_line_numbers::in, maybe(string)::in, string::in,
- foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det.
+ foreign_literal_or_include::in, prog_context::in, maybe_error::out,
+ io::di, io::uo) is det.
output_foreign_literal_or_include(Stream, MaybeSetLineNumbers,
- MaybeThisFileName, SourceFileName, LiteralOrInclude, Context, !IO) :-
+ MaybeThisFileName, SourceFileName, LiteralOrInclude, Context,
+ Res, !IO) :-
(
LiteralOrInclude = floi_literal(Code),
term.context_file(Context, File),
term.context_line(Context, Line),
c_util.maybe_set_line_num(Stream, MaybeSetLineNumbers, File, Line,
!IO),
- io.write_string(Stream, Code, !IO)
+ io.write_string(Stream, Code, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFileName),
make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
c_util.maybe_set_line_num(Stream, MaybeSetLineNumbers, IncludePath, 1,
!IO),
- write_include_file_contents(Stream, IncludePath, !IO)
+ write_include_file_contents(Stream, IncludePath, Res, !IO)
),
io.nl(Stream, !IO),
c_util.maybe_reset_line_num(Stream, MaybeSetLineNumbers, MaybeThisFileName,
!IO).
%-----------------------------------------------------------------------------%
%
% Code for writing out foreign exported enumerations.
%
diff --git a/compiler/file_util.m b/compiler/file_util.m
index 84f1764b6..f0caa2905 100644
--- a/compiler/file_util.m
+++ b/compiler/file_util.m
@@ -1,14 +1,15 @@
%-----------------------------------------------------------------------------e
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------e
% Copyright (C) 2008-2011 The University of Melbourne.
+% Copyright (C) 2013-2015, 2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: file_util.m.
%
% Utility predicates for operating on files that do not require any access
% to the parse_tree package or anything above it.
%
%---------------------------------------------------------------------------%
@@ -86,39 +87,32 @@
% Search Dirs for FileName. If found, return the last modification time
% of the file that was found. Do NOT open the file for reading.
%
:- pred search_for_file_mod_time(list(dir_name)::in, file_name::in,
maybe_error(time_t)::out, io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% Write to a given filename, giving appropriate status messages
% and error messages if the file cannot be opened.
- % This will catch and report include_file_error exceptions.
%
:- pred output_to_file(globals::in, string::in,
- pred(io, io)::in(pred(di, uo) is det), bool::out, io::di, io::uo) is det.
+ pred(list(string), io, io)::in(pred(out, di, uo) is det), bool::out,
+ io::di, io::uo) is det.
- % Same as output_to_file above, but allow the writing predicate
- % to generate something, and if it succeeds, return its result.
- %
-:- pred output_to_file_return_result(globals::in, string::in,
- pred(T, io, io)::in(pred(out, di, uo) is det),
- maybe(T)::out, io::di, io::uo) is det.
+%---------------------------------------------------------------------------%
% Write the contents of the given file to the specified output stream.
- % Throws include_file_error exceptions for errors relating to the
- % include file.
%
:- pred write_include_file_contents(io.text_output_stream::in, string::in,
- io::di, io::uo) is det.
-:- pred write_include_file_contents_cur_stream(string::in,
+ maybe_error::out, io::di, io::uo) is det.
+:- pred write_include_file_contents_cur_stream(string::in, maybe_error::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
% get_install_name_option(FileName, Option, !IO):
%
% Get the option string for setting the install-name of the shared library
% FileName. This is only used for systems which support the install-name
% option for shared libraries (such as Darwin).
%
@@ -178,23 +172,20 @@
:- implementation.
:- import_module libs.compute_grade.
:- import_module libs.options.
:- import_module dir.
:- import_module exception.
:- import_module string.
:- import_module univ.
-:- type include_file_error
- ---> include_file_error(string, string).
-
%---------------------------------------------------------------------------%
search_for_file(Dirs, FileName, MaybeFilePathName, !IO) :-
search_for_file_and_stream(Dirs, FileName, MaybeFilePathNameAndStream,
!IO),
(
MaybeFilePathNameAndStream =
ok(path_name_and_stream(FilePathName, Stream)),
io.close_input(Stream, !IO),
MaybeFilePathName = ok(FilePathName)
@@ -328,120 +319,117 @@ make_path_name_noncanon(Dir, FileName, PathName) :-
else
% dir.make_path_name is slow so we avoid it when path names don't
% need to be canonicalised.
Sep = string.from_char(dir.directory_separator),
PathName = string.append_list([Dir, Sep, FileName])
).
%---------------------------------------------------------------------------%
output_to_file(Globals, FileName, Action, Succeeded, !IO) :-
- ActionReturnDummy = (pred(0::out, di, uo) is det --> Action),
- output_to_file_return_result(Globals, FileName, ActionReturnDummy,
- Result, !IO),
- (
- Result = yes(_),
- Succeeded = yes
- ;
- Result = no,
- Succeeded = no
- ).
-
-output_to_file_return_result(Globals, FileName, Action, Result, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Writing to file `", !IO),
maybe_write_string(Verbose, FileName, !IO),
maybe_write_string(Verbose, "'...\n", !IO),
maybe_flush_output(Verbose, !IO),
io.open_output(FileName, Res, !IO),
(
Res = ok(FileStream),
io.set_output_stream(FileStream, OrigOutputStream, !IO),
promise_equivalent_solutions [TryResult, !:IO] (
try_io(Action, TryResult, !IO)
),
io.set_output_stream(OrigOutputStream, _, !IO),
io.close_output(FileStream, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO),
(
- TryResult = succeeded(ActionResult),
- Result = yes(ActionResult)
- ;
- TryResult = exception(Univ),
- ( if univ_to_type(Univ, IncludeError) then
- IncludeError = include_file_error(IncludeFileName, Detail),
- string.format("can't open `%s' for input: %s",
- [s(IncludeFileName), s(Detail)], ErrorMessage),
+ TryResult = succeeded(Errors),
+ (
+ Errors = [],
+ Succeeded = yes
+ ;
+ Errors = [_ | _],
maybe_write_string(Verbose, "\n", !IO),
- report_error(ErrorMessage, !IO),
- Result = no
- else
- rethrow(TryResult)
+ foldl(report_error, Errors, !IO),
+ Succeeded = no
)
+ ;
+ TryResult = exception(_),
+ rethrow(TryResult)
)
;
Res = error(_),
maybe_write_string(Verbose, "\n", !IO),
string.append_list(["can't open file `", FileName, "' for output."],
ErrorMessage),
report_error(ErrorMessage, !IO),
- Result = no
+ Succeeded = no
).
%---------------------------------------------------------------------------%
-write_include_file_contents(OutputStream, FileName, !IO) :-
+write_include_file_contents(OutputStream, FileName, Res, !IO) :-
FollowSymLinks = yes,
- io.file_type(FollowSymLinks, FileName, MaybeType, !IO),
+ io.file_type(FollowSymLinks, FileName, MaybeFileType, !IO),
(
- MaybeType = ok(Type),
- ( if possibly_regular_file(Type) then
- copy_file_to_stream(FileName, OutputStream, !IO)
+ MaybeFileType = ok(FileType),
+ ( if possibly_regular_file(FileType) then
+ copy_file_to_stream(FileName, OutputStream, CopyRes, !IO),
+ (
+ CopyRes = ok,
+ Res = ok
+ ;
+ CopyRes = error(Error),
+ Message = io.error_message(Error),
+ Res = error(cannot_open_file_for_input(FileName, Message))
+ )
else
- throw(include_file_error(FileName, "Not a regular file"))
+ Message = "Not a regular file",
+ Res = error(cannot_open_file_for_input(FileName, Message))
)
;
- MaybeType = error(Error),
- Msg = string.remove_prefix_if_present("can't find file type: ",
- io.error_message(Error)),
- throw(include_file_error(FileName, Msg))
+ MaybeFileType = error(FileTypeError),
+ Message = string.remove_prefix_if_present("can't find file type: ",
+ io.error_message(FileTypeError)),
+ Res = error(cannot_open_file_for_input(FileName, Message))
).
-write_include_file_contents_cur_stream(FileName, !IO) :-
+write_include_file_contents_cur_stream(FileName, Res, !IO) :-
io.output_stream(OutputStream, !IO),
- write_include_file_contents(OutputStream, FileName, !IO).
+ write_include_file_contents(OutputStream, FileName, Res, !IO).
-:- pred copy_file_to_stream(string::in, io.output_stream::in,
+:- pred copy_file_to_stream(string::in, io.output_stream::in, io.res::out,
io::di, io::uo) is det.
-copy_file_to_stream(FileName, OutputStream, !IO) :-
+copy_file_to_stream(FileName, OutputStream, Res, !IO) :-
io.open_input(FileName, OpenRes, !IO),
(
OpenRes = ok(InputStream),
promise_equivalent_solutions [TryResult, !:IO] (
try_io(copy_stream(InputStream, OutputStream), TryResult, !IO)
),
io.close_input(InputStream, !IO),
(
- TryResult = succeeded(ok)
+ TryResult = succeeded(ok),
+ Res = ok
;
TryResult = succeeded(error(Error)),
- throw(Error)
+ Res = error(Error)
;
TryResult = exception(_),
rethrow(TryResult)
)
;
OpenRes = error(Error),
- throw(include_file_error(FileName, io.error_message(Error)))
+ Res = error(Error)
).
:- pred copy_stream(io.input_stream::in, io.output_stream::in,
io.res::out, io::di, io::uo) is det.
copy_stream(InputStream, OutputStream, Res, !IO) :-
io.read_file_as_string(InputStream, ReadRes, !IO),
(
ReadRes = ok(InputContents),
io.write_string(OutputStream, InputContents, !IO),
@@ -449,20 +437,25 @@ copy_stream(InputStream, OutputStream, Res, !IO) :-
;
ReadRes = error(_Partial, Error),
Res = error(Error)
).
:- pred possibly_regular_file(io.file_type::in) is semidet.
possibly_regular_file(regular_file).
possibly_regular_file(unknown).
+:- func cannot_open_file_for_input(string, string) = string.
+
+cannot_open_file_for_input(FileName, Error) =
+ string.format("can't open `%s' for input: %s", [s(FileName), s(Error)]).
+
%---------------------------------------------------------------------------%
% Changes to the following predicate may require similar changes to
% make.program_target.install_library_grade_files/9.
get_install_name_option(Globals, OutputFileName, InstallNameOpt) :-
globals.lookup_string_option(Globals, shlib_linker_install_name_flag,
InstallNameFlag),
globals.lookup_string_option(Globals, shlib_linker_install_name_path,
InstallNamePath0),
diff --git a/compiler/llds_out_file.m b/compiler/llds_out_file.m
index 96b0ee79e..acfad4efd 100644
--- a/compiler/llds_out_file.m
+++ b/compiler/llds_out_file.m
@@ -1,14 +1,15 @@
%----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%----------------------------------------------------------------------------%
% Copyright (C) 2009-2011 The University of Melbourne.
+% Copyright (C) 2013-2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%----------------------------------------------------------------------------%
%
% File: llds_out_file.m.
% Main authors: conway, fjh, zs.
%
% This module defines the top level routines for printing out LLDS modules.
% It looks after printing out global data, procedures (but not instructions),
% and module initialization functions.
@@ -67,20 +68,21 @@
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.c_util.
:- import_module backend_libs.name_mangle.
:- import_module backend_libs.proc_label.
:- import_module backend_libs.rtti.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.options.
:- import_module libs.trace_params.
:- import_module ll_backend.exprn_aux.
:- import_module ll_backend.layout.
:- import_module ll_backend.layout_out.
:- import_module ll_backend.llds_out.llds_out_code_addr.
:- import_module ll_backend.llds_out.llds_out_data.
:- import_module ll_backend.llds_out.llds_out_global.
:- import_module ll_backend.llds_out.llds_out_instr.
@@ -112,30 +114,31 @@
%----------------------------------------------------------------------------%
output_llds(Globals, CFile, Succeeded, !IO) :-
ModuleName = CFile ^ cfile_modulename,
module_name_to_file_name(Globals, do_create_dirs, ".c",
ModuleName, FileName, !IO),
output_to_file(Globals, FileName, output_llds_2(Globals, CFile),
Succeeded, !IO).
-:- pred output_llds_2(globals::in, c_file::in, io::di, io::uo) is det.
+:- pred output_llds_2(globals::in, c_file::in, list(string)::out,
+ io::di, io::uo) is det.
-output_llds_2(Globals, CFile, !IO) :-
+output_llds_2(Globals, CFile, Errors, !IO) :-
decl_set_init(DeclSet0),
- output_single_c_file(Globals, CFile, DeclSet0, _, !IO).
+ output_single_c_file(Globals, CFile, Errors, DeclSet0, _, !IO).
-:- pred output_single_c_file(globals::in, c_file::in,
+:- pred output_single_c_file(globals::in, c_file::in, list(string)::out,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_single_c_file(Globals, CFile, !DeclSet, !IO) :-
+output_single_c_file(Globals, CFile, Errors, !DeclSet, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, ForeignBodyCodes, Exports,
TablingInfoStructs, ScalarCommonDatas, VectorCommonDatas,
RttiDatas, PseudoTypeInfos, HLDSVarNums, ShortLocns, LongLocns,
UserEventVarNums, UserEvents,
NoVarLabelLayouts, SVarLabelLayouts, LVarLabelLayouts,
InternalLabelToLayoutMap, EntryLabelToLayoutMap,
CallSiteStatics, CoveragePoints, ProcStatics,
ProcHeadVarNums, ProcVarNames, ProcBodyBytecodes, TSStringTable,
TableIoEntries, TableIoEntryMap, ProcEventLayouts, ExecTraces,
ProcLayoutDatas, ModuleLayoutDatas, ClosureLayoutDatas,
@@ -152,21 +155,22 @@ output_single_c_file(Globals, CFile, !DeclSet, !IO) :-
annotate_c_modules(Info, Modules, AnnotatedModules,
cord.init, EntryLabelsCord, cord.init, InternalLabelsCord,
set.init, EnvVarNameSet),
EntryLabels = cord.list(EntryLabelsCord),
InternalLabels = cord.list(InternalLabelsCord),
EnvVarNames = set.to_sorted_list(EnvVarNameSet),
output_init_comment(ModuleName, UserInitPredCNames, UserFinalPredCNames,
EnvVarNames, !IO),
output_c_file_mercury_headers(Info, !IO),
- output_foreign_header_include_lines(Info, C_HeaderLines, !IO),
+ output_foreign_header_include_lines(Info, C_HeaderLines,
+ ForeignIncludeResults, !IO),
io.write_string("\n", !IO),
output_static_linkage_define(!IO),
list.foldl2(output_scalar_common_data_decl, ScalarCommonDatas,
!DeclSet, !IO),
list.foldl2(output_vector_common_data_decl, VectorCommonDatas,
!DeclSet, !IO),
output_rtti_data_decl_list(Info, RttiDatas, !DeclSet, !IO),
output_record_c_label_decls(Info, EntryLabels, InternalLabels,
!DeclSet, !IO),
@@ -198,31 +202,36 @@ output_single_c_file(Globals, CFile, !DeclSet, !IO) :-
output_layout_array_defns(Info, PseudoTypeInfos, HLDSVarNums,
ShortLocns, LongLocns, UserEventVarNums, UserEvents,
NoVarLabelLayouts, SVarLabelLayouts, LVarLabelLayouts,
CallSiteStatics, CoveragePoints, ProcStatics,
ProcHeadVarNums, ProcVarNames, ProcBodyBytecodes, TableIoEntries,
ProcEventLayouts, ExecTraces, TSStringTable, AllocSites,
!DeclSet, !IO),
list.foldl2(output_annotated_c_module(Info), AnnotatedModules,
!DeclSet, !IO),
- list.foldl(output_foreign_body_code(Info), ForeignBodyCodes, !IO),
+ list.map_foldl(output_foreign_body_code(Info), ForeignBodyCodes,
+ ForeignCodeResults, !IO),
WriteForeignExportDefn =
(pred(ForeignExportDefn::in, IO0::di, IO::uo) is det :-
ForeignExportDefn = foreign_export_defn(ForeignExportCode),
io.write_string(ForeignExportCode, IO0, IO)
),
list.foldl(WriteForeignExportDefn, Exports, !IO),
io.write_string("\n", !IO),
output_c_module_init_list(Info, ModuleName, AnnotatedModules, RttiDatas,
ProcLayoutDatas, ModuleLayoutDatas, ComplexityProcs, TSStringTable,
- AllocSites, UserInitPredCNames, UserFinalPredCNames, !DeclSet, !IO).
+ AllocSites, UserInitPredCNames, UserFinalPredCNames, !DeclSet, !IO),
+
+ list.filter_map(maybe_is_error, ForeignIncludeResults, ErrorsA),
+ list.filter_map(maybe_is_error, ForeignCodeResults, ErrorsB),
+ Errors = ErrorsA ++ ErrorsB.
%-----------------------------------------------------------------------------%
:- pred output_c_file_mercury_headers(llds_out_info::in,
io::di, io::uo) is det.
output_c_file_mercury_headers(Info, !IO) :-
io.write_string("#define MR_ALLOW_RESET\n", !IO),
io.write_string("#include ""mercury_imp.h""\n", !IO),
TraceLevel = Info ^ lout_trace_level,
@@ -879,99 +888,101 @@ output_static_linkage_define(!IO) :-
io.write_string("#ifdef _MSC_VER\n", !IO),
io.write_string("#define MR_STATIC_LINKAGE extern\n", !IO),
io.write_string("#else\n", !IO),
io.write_string("#define MR_STATIC_LINKAGE static\n", !IO),
io.write_string("#endif\n", !IO).
%----------------------------------------------------------------------------%
:- pred output_foreign_body_code(llds_out_info::in, foreign_body_code::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
-output_foreign_body_code(Info, ForeignBodyCode, !IO) :-
+output_foreign_body_code(Info, ForeignBodyCode, Res, !IO) :-
ForeignBodyCode = foreign_body_code(Lang, LiteralOrInclude, Context),
(
Lang = lang_c,
output_foreign_decl_or_code(Info, "foreign_code", Lang,
- LiteralOrInclude, Context, !IO)
+ LiteralOrInclude, Context, Res, !IO)
;
( Lang = lang_java
; Lang = lang_csharp
; Lang = lang_erlang
),
unexpected($pred, "unimplemented: foreign code other than C")
).
:- pred output_foreign_header_include_lines(llds_out_info::in,
- list(foreign_decl_code)::in, io::di, io::uo) is det.
+ list(foreign_decl_code)::in, list(maybe_error)::out, io::di, io::uo)
+ is det.
-output_foreign_header_include_lines(Info, Decls, !IO) :-
- list.foldl2(output_foreign_header_include_line(Info), Decls,
+output_foreign_header_include_lines(Info, Decls, Results, !IO) :-
+ list.map_foldl2(output_foreign_header_include_line(Info), Decls, Results,
set.init, _, !IO).
:- pred output_foreign_header_include_line(llds_out_info::in,
- foreign_decl_code::in,
+ foreign_decl_code::in, maybe_error::out,
set(foreign_literal_or_include)::in, set(foreign_literal_or_include)::out,
io::di, io::uo) is det.
-output_foreign_header_include_line(Info, Decl, !AlreadyDone, !IO) :-
+output_foreign_header_include_line(Info, Decl, Res, !AlreadyDone, !IO) :-
Decl = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_c,
% This will not deduplicate the content of included files.
( if set.insert_new(LiteralOrInclude, !AlreadyDone) then
output_foreign_decl_or_code(Info, "foreign_decl", Lang,
- LiteralOrInclude, Context, !IO)
+ LiteralOrInclude, Context, Res, !IO)
else
- true
+ Res = ok
)
;
( Lang = lang_java
; Lang = lang_csharp
; Lang = lang_erlang
),
unexpected($pred, "foreign decl code other than C")
).
:- pred output_foreign_decl_or_code(llds_out_info::in, string::in,
foreign_language::in, foreign_literal_or_include::in, prog_context::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
output_foreign_decl_or_code(Info, PragmaType, Lang, LiteralOrInclude, Context,
- !IO) :-
+ Res, !IO) :-
AutoComments = Info ^ lout_auto_comments,
ForeignLineNumbers = Info ^ lout_foreign_line_numbers,
( if
AutoComments = yes,
ForeignLineNumbers = yes
then
io.write_string("/* ", !IO),
prog_out.write_context(Context, !IO),
io.write_string(" pragma ", !IO),
io.write_string(PragmaType, !IO),
io.write_string("(", !IO),
io.write(Lang, !IO),
io.write_string(") */\n", !IO)
else
true
),
(
LiteralOrInclude = floi_literal(Code),
output_set_line_num(ForeignLineNumbers, Context, !IO),
- io.write_string(Code, !IO)
+ io.write_string(Code, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFileName),
SourceFileName = Info ^ lout_source_file_name,
make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
output_set_line_num(ForeignLineNumbers, context(IncludePath, 1), !IO),
- write_include_file_contents_cur_stream(IncludePath, !IO)
+ write_include_file_contents_cur_stream(IncludePath, Res, !IO)
),
io.nl(!IO),
output_reset_line_num(ForeignLineNumbers, !IO).
:- pred output_record_c_label_decls(llds_out_info::in,
list(label)::in, list(label)::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
output_record_c_label_decls(Info, EntryLabels, InternalLabels,
!DeclSet, !IO) :-
diff --git a/compiler/mlds_to_c_file.m b/compiler/mlds_to_c_file.m
index fc87a6f0c..9cfa029c9 100644
--- a/compiler/mlds_to_c_file.m
+++ b/compiler/mlds_to_c_file.m
@@ -1,15 +1,15 @@
%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1999-2012 The University of Melbourne.
-% Copyright (C) 2013-2017 The Mercury team.
+% Copyright (C) 2013-2018 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: mlds_to_c.m.
% Main author: fjh.
%
% Convert MLDS to C/C++ code.
%
% TODO:
@@ -66,20 +66,21 @@
:- implementation.
:- import_module backend_libs.
:- import_module backend_libs.c_util.
:- import_module backend_libs.foreign.
:- import_module backend_libs.name_mangle.
:- import_module hlds.
:- import_module hlds.code_model.
:- import_module hlds.hlds_pred. % for pred_proc_id.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.mlds_to_c_class.
:- import_module ml_backend.mlds_to_c_export.
:- import_module ml_backend.mlds_to_c_func.
:- import_module ml_backend.mlds_to_c_global.
@@ -187,40 +188,45 @@ func_defn_has_name_in_list(DumpPredNames, FuncDefn) :-
FuncDefn ^ mfd_function_name = mlds_function_name(PlainFuncName),
PlainFuncName = mlds_plain_func_name(FuncLabel, _),
FuncLabel = mlds_func_label(ProcLabel, _MaybeSeqNum),
ProcLabel = mlds_proc_label(PredLabel, _ProcId),
PredLabel = mlds_user_pred_label(_PredOrFunc, _DeclModule, Name,
_Arity, _CodeModel, _MaybeReturnValue),
list.member(Name, DumpPredNames).
:- pred mlds_output_named_function_defns(mlds_to_c_opts::in,
list(string)::in, mlds_module_name::in, list(mlds_function_defn)::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-mlds_output_named_function_defns(_Opts, _DumpPredNames, _ModuleName, [], !IO).
-mlds_output_named_function_defns(Opts, DumpPredNames, ModuleName,
- [FuncDefn | FuncDefns], !IO) :-
- ( if func_defn_has_name_in_list(DumpPredNames, FuncDefn) then
- Indent = 0,
- mlds_output_function_defn(Opts, Indent, ModuleName, FuncDefn, !IO)
- else
- true
- ),
- mlds_output_named_function_defns(Opts, DumpPredNames, ModuleName,
- FuncDefns, !IO).
+mlds_output_named_function_defns(Opts, DumpPredNames, ModuleName, FuncDefns,
+ Errors, !IO) :-
+ (
+ FuncDefns = [],
+ Errors = []
+ ;
+ FuncDefns = [FuncDefn | FuncDefnsTail],
+ ( if func_defn_has_name_in_list(DumpPredNames, FuncDefn) then
+ Indent = 0,
+ mlds_output_function_defn(Opts, Indent, ModuleName, FuncDefn, !IO)
+ else
+ true
+ ),
+ mlds_output_named_function_defns(Opts, DumpPredNames, ModuleName,
+ FuncDefnsTail, Errors, !IO)
+ ).
%---------------------------------------------------------------------------%
:- pred mlds_output_hdr_file(mlds_to_c_opts::in, indent::in, mlds::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-mlds_output_hdr_file(Opts, Indent, MLDS, !IO) :-
+mlds_output_hdr_file(Opts, Indent, MLDS, Errors, !IO) :-
% The header file must contain _definitions_ of all public types, but only
% _declarations_ of all public variables, constants, and functions.
%
% Note that we do not forward-declare the types here; the forward
% declarations that we need for types used in function prototypes
% are generated by mlds_output_type_forward_decls.
%
% We sort the definitions before we print them so that a change that
% reorders some predicates in a module, which would normally lead
% to a change in the order of the corresponding MLDS definitions,
@@ -253,21 +259,22 @@ mlds_output_hdr_file(Opts, Indent, MLDS, !IO) :-
list.sort(PublicGlobarVarDefns, SortedPublicGlobarVarDefns),
list.sort(PublicFuncDefns, SortedPublicFuncDefns),
mlds_output_hdr_start(Opts, Indent, ModuleName, !IO),
io.nl(!IO),
mlds_output_hdr_imports(Indent, Imports, !IO),
io.nl(!IO),
% Get the foreign code for C.
ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
- mlds_output_c_hdr_decls(Opts, Indent, MLDS_ModuleName, ForeignCode, !IO),
+ mlds_output_c_hdr_decls(Opts, Indent, MLDS_ModuleName, ForeignCode,
+ Errors, !IO),
io.nl(!IO),
mlds_output_export_enums(Opts, Indent, ExportEnums, !IO),
io.nl(!IO),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
list.foldl(mlds_output_class_defn(Opts, Indent, MLDS_ModuleName),
PublicTypeDefns, !IO),
io.nl(!IO),
StdOpts = Opts ^ m2co_std_func_decl := yes,
mlds_output_global_var_decls(StdOpts, Indent, MLDS_ModuleName,
@@ -328,23 +335,23 @@ mlds_output_src_import(Opts, _Indent, Import, !IO) :-
!IO),
io.write_strings(["#include """, HeaderFile, """\n"], !IO).
% Generate the `.c' file.
%
% (Calling it the "source" file is a bit of a misnomer, since in our case
% it is actually the target file, but there is no obvious alternative term
% to use which also has a clear and concise abbreviation, so never mind...)
%
:- pred mlds_output_src_file(mlds_to_c_opts::in, indent::in, mlds::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-mlds_output_src_file(Opts, Indent, MLDS, !IO) :-
+mlds_output_src_file(Opts, Indent, MLDS, Errors, !IO) :-
% The public types have already been defined in the header file, and the
% public vars, consts, and functions have already been declared in the
% header file. In the source file, we need to have
%
% #1. definitions of the private types,
% #2. forward declarations of the private non-types
% #3. definitions of all the non-types
% #4. initialization functions
%
% in that order.
@@ -378,21 +385,21 @@ mlds_output_src_file(Opts, Indent, MLDS, !IO) :-
ForeignCode = mlds_get_c_foreign_code(AllForeignCode),
EnvVarNameSet = mlds_get_env_var_names(ProcDefns),
set.to_sorted_list(EnvVarNameSet, EnvVarNames),
mlds_output_src_start(Opts, Indent, ModuleName, ForeignCode,
InitPreds, FinalPreds, EnvVarNames, !IO),
io.nl(!IO),
mlds_output_src_imports(Opts, Indent, Imports, !IO),
io.nl(!IO),
- mlds_output_c_decls(Opts, Indent, ForeignCode, !IO),
+ mlds_output_c_decls(Opts, Indent, ForeignCode, ForeignDeclErrors, !IO),
io.nl(!IO),
list.foldl(mlds_output_env_var_decl, EnvVarNames, !IO),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
list.foldl(mlds_output_class_defn(Opts, Indent, MLDS_ModuleName),
PrivateTypeDefns, !IO),
io.nl(!IO),
mlds_output_global_var_decls(Opts, Indent, MLDS_ModuleName,
PrivateGlobalVarDefns, !IO),
@@ -415,39 +422,42 @@ mlds_output_src_file(Opts, Indent, MLDS, !IO) :-
mlds_output_scalar_cell_group_defns(Opts, Indent, MangledModuleName,
ScalarCellGroups, !IO),
io.nl(!IO),
mlds_output_vector_cell_group_defns(Opts, Indent, MangledModuleName,
VectorCellGroups, !IO),
io.nl(!IO),
mlds_output_alloc_site_defns(Opts, Indent, MLDS_ModuleName, AllocSites,
!IO),
io.nl(!IO),
- mlds_output_c_defns(Opts, MLDS_ModuleName, Indent, ForeignCode, !IO),
+ mlds_output_c_defns(Opts, MLDS_ModuleName, Indent, ForeignCode,
+ ForeignCodeErrors, !IO),
io.nl(!IO),
mlds_output_global_var_defns(Opts, Indent, yes, MLDS_ModuleName,
RttiDefns, !IO),
mlds_output_function_defns(Opts, Indent, MLDS_ModuleName,
ClosureWrapperFuncDefns, !IO),
mlds_output_global_var_defns(Opts, Indent, yes, MLDS_ModuleName,
CellDefns, !IO),
mlds_output_global_var_defns(Opts, Indent, yes, MLDS_ModuleName,
TableStructDefns, !IO),
mlds_output_function_defns(Opts, Indent, MLDS_ModuleName,
ProcDefns, !IO),
io.nl(!IO),
mlds_output_init_fn_defns(Opts, MLDS_ModuleName, FuncDefns,
TypeCtorInfoDefns, AllocSites, InitPreds, FinalPreds, !IO),
io.nl(!IO),
mlds_output_grade_check_fn_defn(MLDS_ModuleName, !IO),
io.nl(!IO),
- mlds_output_src_end(Indent, ModuleName, !IO).
+ mlds_output_src_end(Indent, ModuleName, !IO),
+
+ Errors = ForeignDeclErrors ++ ForeignCodeErrors.
:- func mlds_get_env_var_names(list(mlds_function_defn)) = set(string).
mlds_get_env_var_names(FuncDefns) = EnvVarNameSet :-
list.map(mlds_get_env_var_names_from_defn, FuncDefns, EnvVarNameSets),
EnvVarNameSet = set.union_list(EnvVarNameSets).
:- pred mlds_get_env_var_names_from_defn(mlds_function_defn::in,
set(string)::out) is det.
@@ -889,23 +899,24 @@ mlds_output_call_to_register_alloc_sites(AllocSites, !IO) :-
io.write_int(Length, !IO),
io.write_string(");\n", !IO)
).
%---------------------------------------------------------------------------%
%
% Foreign language interface stuff.
%
:- pred mlds_output_c_hdr_decls(mlds_to_c_opts::in, indent::in,
- mlds_module_name::in, mlds_foreign_code::in, io::di, io::uo) is det.
+ mlds_module_name::in, mlds_foreign_code::in, list(string)::out,
+ io::di, io::uo) is det.
-mlds_output_c_hdr_decls(Opts, Indent, ModuleName, ForeignCode, !IO) :-
+mlds_output_c_hdr_decls(Opts, Indent, ModuleName, ForeignCode, Errors, !IO) :-
ForeignCode = mlds_foreign_code(DeclCodes, _BodyCodes, _Imports,
_ExportDefns),
( if is_std_lib_module(ModuleName, StdlibModuleName) then
SymName = StdlibModuleName
else
SymName = mlds_module_name_to_sym_name(ModuleName)
),
DeclGuard = decl_guard(SymName),
io.write_strings(["#ifndef ", DeclGuard, "\n#define ", DeclGuard, "\n"],
@@ -915,122 +926,132 @@ mlds_output_c_hdr_decls(Opts, Indent, ModuleName, ForeignCode, !IO) :-
% in cases any foreign_types defined in them are referenced by the extern
% declarations required by mutables.
AncestorModuleNames = get_ancestors(SymName),
list.map(module_name_to_file_name_stem,
AncestorModuleNames, AncestorFileNames),
WriteAncestorInclude = (pred(Ancestor::in, !.IO::di, !:IO::uo) is det :-
io.write_strings(["#include \"", Ancestor, ".mih", "\"\n"], !IO)
),
list.foldl(WriteAncestorInclude, AncestorFileNames, !IO),
- io.write_list(DeclCodes, "\n",
+ list.map_foldl(
mlds_output_c_hdr_decl(Opts, Indent, yes(foreign_decl_is_exported)),
- !IO),
+ DeclCodes, DeclResults, !IO),
+ list.filter_map(maybe_is_error, DeclResults, Errors),
io.write_string("\n#endif\n", !IO).
:- pred mlds_output_c_hdr_decl(mlds_to_c_opts::in, indent::in,
- maybe(foreign_decl_is_local)::in, foreign_decl_code::in,
+ maybe(foreign_decl_is_local)::in, foreign_decl_code::in, maybe_error::out,
io::di, io::uo) is det.
-mlds_output_c_hdr_decl(Opts, _Indent, MaybeDesiredIsLocal, DeclCode, !IO) :-
+mlds_output_c_hdr_decl(Opts, _Indent, MaybeDesiredIsLocal, DeclCode, Res,
+ !IO) :-
DeclCode = foreign_decl_code(Lang, IsLocal, LiteralOrInclude, Context),
% Only output C code in the C header file.
(
Lang = lang_c,
( if
(
MaybeDesiredIsLocal = no
;
MaybeDesiredIsLocal = yes(DesiredIsLocal),
IsLocal = DesiredIsLocal
)
then
mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude,
- Context, !IO)
+ Context, Res, !IO)
else
- true
+ Res = ok
)
;
( Lang = lang_java
; Lang = lang_csharp
; Lang = lang_erlang
),
sorry($pred, "foreign code other than C")
).
:- pred mlds_output_c_decls(mlds_to_c_opts::in, indent::in,
- mlds_foreign_code::in, io::di, io::uo) is det.
+ mlds_foreign_code::in, list(string)::out, io::di, io::uo) is det.
-mlds_output_c_decls(Opts, Indent, ForeignCode, !IO) :-
+mlds_output_c_decls(Opts, Indent, ForeignCode, Errors, !IO) :-
ForeignCode = mlds_foreign_code(HeaderCodes, _BodyCodes, _Imports,
_ExportDefns),
- io.write_list(HeaderCodes, "\n",
- mlds_output_c_hdr_decl(Opts, Indent, yes(foreign_decl_is_local)), !IO).
+ list.map_foldl(
+ mlds_output_c_hdr_decl(Opts, Indent, yes(foreign_decl_is_local)),
+ HeaderCodes, Results, !IO),
+ list.filter_map(maybe_is_error, Results, Errors).
:- pred mlds_output_c_defns(mlds_to_c_opts::in, mlds_module_name::in,
- indent::in, mlds_foreign_code::in, io::di, io::uo) is det.
+ indent::in, mlds_foreign_code::in, list(string)::out, io::di, io::uo)
+ is det.
-mlds_output_c_defns(Opts, ModuleName, Indent, ForeignCode, !IO) :-
+mlds_output_c_defns(Opts, ModuleName, Indent, ForeignCode, Errors, !IO) :-
ForeignCode = mlds_foreign_code(_HeaderCodes, BodyCodes,
Imports, ExportDefns),
list.foldl(mlds_output_c_foreign_import_module(Opts, Indent),
Imports, !IO),
- io.write_list(BodyCodes, "\n", mlds_output_c_defn(Opts, Indent), !IO),
+ list.map_foldl(mlds_output_c_defn(Opts, Indent), BodyCodes, Results, !IO),
io.write_string("\n", !IO),
io.write_list(ExportDefns, "\n",
- mlds_output_pragma_export_defn(Opts, ModuleName, Indent), !IO).
+ mlds_output_pragma_export_defn(Opts, ModuleName, Indent), !IO),
+ list.filter_map(maybe_is_error, Results, Errors).
:- pred mlds_output_c_foreign_import_module(mlds_to_c_opts::in, int::in,
foreign_import_module_info::in, io::di, io::uo) is det.
mlds_output_c_foreign_import_module(Opts, Indent, ForeignImport, !IO) :-
ForeignImport = foreign_import_module_info(Lang, Import),
(
Lang = lang_c,
mlds_output_src_import(Opts, Indent,
mercury_import(user_visible_interface,
mercury_module_name_to_mlds(Import)), !IO)
;
( Lang = lang_csharp
; Lang = lang_java
; Lang = lang_erlang
),
sorry($pred, "foreign code other than C")
).
:- pred mlds_output_c_defn(mlds_to_c_opts::in, indent::in,
- foreign_body_code::in, io::di, io::uo) is det.
+ foreign_body_code::in, maybe_error::out, io::di, io::uo) is det.
-mlds_output_c_defn(Opts, _Indent, ForeignBodyCode, !IO) :-
+mlds_output_c_defn(Opts, _Indent, ForeignBodyCode, Res, !IO) :-
ForeignBodyCode = foreign_body_code(Lang, LiteralOrInclude, Context),
(
Lang = lang_c,
mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude, Context,
- !IO)
+ Res, !IO)
;
( Lang = lang_csharp
; Lang = lang_java
; Lang = lang_erlang
),
sorry($pred, "foreign code other than C")
).
:- pred mlds_output_foreign_literal_or_include(mlds_to_c_opts::in,
- foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det.
+ foreign_literal_or_include::in, prog_context::in, maybe_error::out,
+ io::di, io::uo) is det.
-mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude, Context, !IO) :-
+mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude, Context, Res,
+ !IO) :-
(
LiteralOrInclude = floi_literal(Code),
c_output_context(Opts ^ m2co_foreign_line_numbers, Context, !IO),
- io.write_string(Code, !IO)
+ io.write_string(Code, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFileName),
SourceFileName = Opts ^ m2co_source_filename,
make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
c_output_file_line(Opts ^ m2co_foreign_line_numbers,
IncludePath, 1, !IO),
- write_include_file_contents_cur_stream(IncludePath, !IO)
- ).
+ write_include_file_contents_cur_stream(IncludePath, Res, !IO)
+ ),
+ io.nl(!IO).
%---------------------------------------------------------------------------%
:- end_module ml_backend.mlds_to_c_file.
%---------------------------------------------------------------------------%
diff --git a/compiler/mlds_to_cs_file.m b/compiler/mlds_to_cs_file.m
index d27b3d353..e809f70e4 100644
--- a/compiler/mlds_to_cs_file.m
+++ b/compiler/mlds_to_cs_file.m
@@ -28,20 +28,21 @@
:- pred output_csharp_mlds(module_info::in, mlds::in, bool::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.ml_util.
:- import_module ml_backend.mlds_to_cs_class.
:- import_module ml_backend.mlds_to_cs_data.
:- import_module ml_backend.mlds_to_cs_export.
:- import_module ml_backend.mlds_to_cs_func.
@@ -55,41 +56,42 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_out.
:- import_module assoc_list.
:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
%---------------------------------------------------------------------------%
output_csharp_mlds(ModuleInfo, MLDS, Succeeded, !IO) :-
module_info_get_globals(ModuleInfo, Globals),
ModuleName = mlds_get_module_name(MLDS),
module_name_to_file_name(Globals, do_create_dirs, ".cs",
ModuleName, SourceFile, !IO),
Indent = 0,
output_to_file(Globals, SourceFile,
output_csharp_src_file(ModuleInfo, Indent, MLDS), Succeeded, !IO).
:- pred output_csharp_src_file(module_info::in, indent::in, mlds::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
+output_csharp_src_file(ModuleInfo, Indent, MLDS, Errors, !IO) :-
% Run further transformations on the MLDS.
MLDS = mlds(ModuleName, Imports, GlobalData,
TypeDefns, TableStructDefns, ProcDefns,
InitPreds, FinalPreds, AllForeignCode, ExportedEnums),
ml_global_data_get_all_global_defns(GlobalData,
ScalarCellGroupMap, VectorCellGroupMap, _AllocIdMap,
RttiDefns, CellDefns, ClosureWrapperFuncDefns),
% Find all methods which would have their addresses taken to be used as a
% function pointer.
@@ -114,23 +116,24 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
% XXX We should not ignore _Imports.
ForeignCode = mlds_get_csharp_foreign_code(AllForeignCode),
ForeignCode = mlds_foreign_code(ForeignDeclCodes, ForeignBodyCodes,
_Imports, ExportDefns),
% Output transformed MLDS as C# source.
module_info_get_globals(ModuleInfo, Globals),
module_source_filename(Globals, ModuleName, SourceFileName, !IO),
Info = init_csharp_out_info(ModuleInfo, SourceFileName, CodeAddrs),
output_src_start_for_csharp(Info, Indent, ModuleName, Imports,
- ForeignDeclCodes, ProcDefns, !IO),
- io.write_list(ForeignBodyCodes, "\n",
- output_csharp_body_code(Info, Indent), !IO),
+ ForeignDeclCodes, ProcDefns, ForeignDeclErrors, !IO),
+ list.map_foldl(output_csharp_body_code(Info, Indent),
+ ForeignBodyCodes, ForeignCodeResults, !IO),
+ list.filter_map(maybe_is_error, ForeignCodeResults, ForeignCodeErrors),
output_pragma_warning_disable(!IO),
io.write_string("\n// RttiDefns\n", !IO),
list.foldl(
output_global_var_defn_for_csharp(Info, Indent + 1, oa_alloc_only),
RttiDefns, !IO),
output_rtti_assignments_for_csharp(Info, Indent + 1, RttiDefns, !IO),
io.write_string("\n// Cell and tabling definitions\n", !IO),
@@ -181,90 +184,93 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
StaticCtorCalls = [
"MR_init_rtti",
"MR_init_data",
"MR_init_scalar_common_data",
"MR_init_vector_common_data"
| InitPreds
],
output_static_constructor(ModuleName, Indent + 1, StaticCtorCalls,
FinalPreds, !IO),
- output_src_end_for_csharp(Indent, ModuleName, !IO).
+ output_src_end_for_csharp(Indent, ModuleName, !IO),
+
+ Errors = ForeignDeclErrors ++ ForeignCodeErrors.
:- pred make_code_addr_map_for_csharp(assoc_list(int, mlds_code_addr)::in,
map(mlds_code_addr, string)::in, map(mlds_code_addr, string)::out) is det.
make_code_addr_map_for_csharp([], !CodeAddrMap).
make_code_addr_map_for_csharp([SeqNum - CodeAddr | SeqNumsCodeAddrs],
!CodeAddrMap) :-
Name = "MR_method_ptr_" ++ string.from_int(SeqNum),
map.det_insert(CodeAddr, Name, !CodeAddrMap),
make_code_addr_map_for_csharp(SeqNumsCodeAddrs, !CodeAddrMap).
%---------------------------------------------------------------------------%
%
% Code for working with `foreign_code'.
%
:- pred output_csharp_decl(csharp_out_info::in, indent::in,
- foreign_decl_code::in, io::di, io::uo) is det.
+ foreign_decl_code::in, maybe_error::out, io::di, io::uo) is det.
-output_csharp_decl(Info, Indent, DeclCode, !IO) :-
+output_csharp_decl(Info, Indent, DeclCode, Res, !IO) :-
DeclCode = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_csharp,
output_csharp_foreign_literal_or_include(Info, Indent,
- LiteralOrInclude, Context, !IO)
+ LiteralOrInclude, Context, Res, !IO)
;
( Lang = lang_c
; Lang = lang_java
; Lang = lang_erlang
),
sorry($pred, "foreign decl other than C#")
).
:- pred output_csharp_body_code(csharp_out_info::in, indent::in,
- foreign_body_code::in, io::di, io::uo) is det.
+ foreign_body_code::in, maybe_error::out, io::di, io::uo) is det.
-output_csharp_body_code(Info, Indent, ForeignBodyCode, !IO) :-
+output_csharp_body_code(Info, Indent, ForeignBodyCode, Res, !IO) :-
ForeignBodyCode = foreign_body_code(Lang, LiteralOrInclude, Context),
% Only output C# code.
(
Lang = lang_csharp,
output_csharp_foreign_literal_or_include(Info, Indent,
- LiteralOrInclude, Context, !IO)
+ LiteralOrInclude, Context, Res, !IO)
;
( Lang = lang_c
; Lang = lang_java
; Lang = lang_erlang
),
sorry($pred, "foreign code other than C#")
).
:- pred output_csharp_foreign_literal_or_include(csharp_out_info::in,
indent::in, foreign_literal_or_include::in, prog_context::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
output_csharp_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
- Context, !IO) :-
+ Context, Res, !IO) :-
(
LiteralOrInclude = floi_literal(Code),
indent_line_after_context(Info ^ csoi_foreign_line_numbers, Context,
Indent, !IO),
- io.write_string(Code, !IO)
+ io.write_string(Code, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFileName),
SourceFileName = Info ^ csoi_source_filename,
make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
cs_output_context(Info ^ csoi_foreign_line_numbers,
context(IncludePath, 1), !IO),
- write_include_file_contents_cur_stream(IncludePath, !IO)
+ write_include_file_contents_cur_stream(IncludePath, Res, !IO)
),
io.nl(!IO),
cs_output_default_context(Info ^ csoi_foreign_line_numbers, !IO).
:- func mlds_get_csharp_foreign_code(map(foreign_language, mlds_foreign_code))
= mlds_foreign_code.
mlds_get_csharp_foreign_code(AllForeignCode) = ForeignCode :-
( if map.search(AllForeignCode, lang_csharp, ForeignCode0) then
ForeignCode = ForeignCode0
@@ -314,33 +320,37 @@ output_env_var_definition_for_csharp(Indent, EnvVarName, !IO) :-
io.write_string(EnvVarName, !IO),
io.write_string("\") == null ? 0 : 1;\n", !IO).
%---------------------------------------------------------------------------%
%
% Code to output the start and end of a source file.
%
:- pred output_src_start_for_csharp(csharp_out_info::in, indent::in,
mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
- list(mlds_function_defn)::in, io::di, io::uo) is det.
+ list(mlds_function_defn)::in, list(string)::out, io::di, io::uo)
+ is det.
output_src_start_for_csharp(Info, Indent, MercuryModuleName, _Imports,
- ForeignDecls, Defns, !IO) :-
+ ForeignDecls, Defns, Errors, !IO) :-
output_auto_gen_comment(Info ^ csoi_source_filename, !IO),
output_n_indents(Indent, !IO),
io.write_string("/* :- module ", !IO),
prog_out.write_sym_name(MercuryModuleName, !IO),
io.write_string(". */\n", !IO),
output_n_indents(Indent, !IO),
io.write_string("namespace mercury {\n\n", !IO),
- io.write_list(ForeignDecls, "\n", output_csharp_decl(Info, Indent), !IO),
+ list.map_foldl(output_csharp_decl(Info, Indent),
+ ForeignDecls, ForeignDeclResults, !IO),
+ list.filter_map(maybe_is_error, ForeignDeclResults, Errors),
+
io.write_string("public static class ", !IO),
mangle_sym_name_for_csharp(MercuryModuleName, module_qual, "__",
ClassName),
io.write_string(ClassName, !IO),
io.write_string(" {\n", !IO),
% Check if this module contains a `main' predicate and if it does insert
% a `main' method in the resulting source file that calls the `main'
% predicate.
( if func_defns_contain_main(Defns) then
diff --git a/compiler/mlds_to_java_file.m b/compiler/mlds_to_java_file.m
index f91799229..d4c26f4de 100644
--- a/compiler/mlds_to_java_file.m
+++ b/compiler/mlds_to_java_file.m
@@ -76,20 +76,21 @@
:- pred output_java_mlds(module_info::in, mlds::in, bool::out,
io::di, io::uo) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module libs.
+:- import_module libs.compiler_util.
:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module mdbcomp.
:- import_module mdbcomp.sym_name.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.ml_rename_classes.
:- import_module ml_backend.ml_util.
:- import_module ml_backend.mlds_to_target_util.
:- import_module ml_backend.mlds_to_java_class.
:- import_module ml_backend.mlds_to_java_export.
@@ -103,20 +104,21 @@
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_out.
:- import_module assoc_list.
:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module map.
+:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
%---------------------------------------------------------------------------%
output_java_mlds(ModuleInfo, MLDS, Succeeded, !IO) :-
@@ -125,23 +127,23 @@ output_java_mlds(ModuleInfo, MLDS, Succeeded, !IO) :-
% that is why we don't call mercury_module_name_to_mlds here.
module_info_get_globals(ModuleInfo, Globals),
ModuleName = mlds_get_module_name(MLDS),
module_name_to_file_name(Globals, do_create_dirs, ".java",
ModuleName, JavaSourceFile, !IO),
Indent = 0,
output_to_file(Globals, JavaSourceFile,
output_java_src_file(ModuleInfo, Indent, MLDS), Succeeded, !IO).
:- pred output_java_src_file(module_info::in, indent::in, mlds::in,
- io::di, io::uo) is det.
+ list(string)::out, io::di, io::uo) is det.
-output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
+output_java_src_file(ModuleInfo, Indent, MLDS, Errors, !IO) :-
% Run further transformations on the MLDS.
MLDS = mlds(ModuleName, Imports, GlobalData,
TypeDefns0, TableStructDefns0, ProcDefns0,
InitPreds, FinalPreds, AllForeignCode, ExportedEnums),
ml_global_data_get_all_global_defns(GlobalData,
ScalarCellGroupMap, VectorCellGroupMap, _AllocIdMap,
RttiDefns0, CellDefns0, ClosureWrapperFuncDefns0),
% Do NOT enforce the outermost "mercury" qualifier here. This module name
% is compared with other module names in the MLDS, to avoid unnecessary
@@ -217,23 +219,24 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
%
% The order is important here, because Java requires static constants
% be defined before they can be used in static initializers.
% We start with the Java foreign code declarations, since for
% library/private_builtin.m they contain static constants
% that will get used in the RTTI definitions.
module_info_get_globals(ModuleInfo, Globals),
module_source_filename(Globals, ModuleName, SourceFileName, !IO),
Info = init_java_out_info(ModuleInfo, SourceFileName, AddrOfMap),
output_src_start_for_java(Info, Indent, ModuleName, Imports,
- ForeignDeclCodes, ProcDefns, !IO),
- io.write_list(ForeignBodyCodes, "\n", output_java_body_code(Info, Indent),
- !IO),
+ ForeignDeclCodes, ProcDefns, ForeignDeclErrors, !IO),
+ list.map_foldl(output_java_body_code(Info, Indent),
+ ForeignBodyCodes, ForeignCodeResults, !IO),
+ list.filter_map(maybe_is_error, ForeignCodeResults, ForeignCodeErrors),
io.write_string("\n// RttiDefns\n", !IO),
list.foldl(
output_global_var_defn_for_java(Info, Indent + 1, oa_alloc_only),
RttiDefns, !IO),
output_rtti_assignments_for_java(Info, Indent + 1, RttiDefns, !IO),
io.write_string("\n// Cell and tabling definitions\n", !IO),
output_global_var_decls_for_java(Info, Indent + 1, CellDefns, !IO),
output_global_var_decls_for_java(Info, Indent + 1, TableStructDefns, !IO),
@@ -274,23 +277,25 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
io.write_string("\n// EnvVarNames\n", !IO),
set.init(EnvVarNamesSet0),
list.foldl(accumulate_env_var_names, ProcDefns,
EnvVarNamesSet0, EnvVarNamesSet1),
list.foldl(accumulate_env_var_names, ClosureWrapperFuncDefns,
EnvVarNamesSet1, EnvVarNamesSet),
set.foldl(output_env_var_definition_for_java(Indent + 1),
EnvVarNamesSet, !IO),
- output_src_end_for_java(Indent, ModuleName, !IO).
+ output_src_end_for_java(Indent, ModuleName, !IO),
% XXX Need to handle non-Java foreign code at this point.
+ Errors = ForeignDeclErrors ++ ForeignCodeErrors.
+
:- pred make_code_addr_map_for_java(list(mlds_code_addr)::in,
multi_map(arity, mlds_code_addr)::in,
multi_map(arity, mlds_code_addr)::out) is det.
make_code_addr_map_for_java([], !Map).
make_code_addr_map_for_java([CodeAddr | CodeAddrs], !Map) :-
CodeAddr = mlds_code_addr(_QualFuncLabel, OrigFuncSignature),
OrigFuncSignature = mlds_func_signature(OrigArgTypes, _OrigRetTypes),
list.length(OrigArgTypes, Arity),
multi_map.set(Arity, CodeAddr, !Map),
@@ -323,70 +328,71 @@ output_import(Import, !IO) :-
% conventions. To avoid these problems, we output dependencies as comments
% only. This is ok, since we always use fully qualified names anyway.
io.write_strings(["// import ", ClassFile, ";\n"], !IO).
%---------------------------------------------------------------------------%
%
% Code for working with Java `foreign_code'.
%
:- pred output_java_decl(java_out_info::in, indent::in, foreign_decl_code::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
-output_java_decl(Info, Indent, DeclCode, !IO) :-
+output_java_decl(Info, Indent, DeclCode, Res, !IO) :-
DeclCode = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_java,
output_java_foreign_literal_or_include(Info, Indent,
- LiteralOrInclude, Context, !IO)
+ LiteralOrInclude, Context, Res, !IO)
;
( Lang = lang_c
; Lang = lang_csharp
; Lang = lang_erlang
),
sorry($pred, "foreign decl other than Java")
).
:- pred output_java_body_code(java_out_info::in, indent::in,
- foreign_body_code::in, io::di, io::uo) is det.
+ foreign_body_code::in, maybe_error::out, io::di, io::uo) is det.
-output_java_body_code(Info, Indent, ForeignBodyCode, !IO) :-
+output_java_body_code(Info, Indent, ForeignBodyCode, Res, !IO) :-
ForeignBodyCode = foreign_body_code(Lang, LiteralOrInclude, Context),
% Only output Java code.
(
Lang = lang_java,
output_java_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
- Context, !IO)
+ Context, Res, !IO)
;
( Lang = lang_c
; Lang = lang_csharp
; Lang = lang_erlang
),
sorry($pred, "foreign code other than Java")
).
:- pred output_java_foreign_literal_or_include(java_out_info::in,
indent::in, foreign_literal_or_include::in, prog_context::in,
- io::di, io::uo) is det.
+ maybe_error::out, io::di, io::uo) is det.
output_java_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
- Context, !IO) :-
+ Context, Res, !IO) :-
(
LiteralOrInclude = floi_literal(Code),
- write_string_with_context_block(Info, Indent, Code, Context, !IO)
+ write_string_with_context_block(Info, Indent, Code, Context, !IO),
+ Res = ok
;
LiteralOrInclude = floi_include_file(IncludeFile),
SourceFileName = Info ^ joi_source_filename,
make_include_file_path(SourceFileName, IncludeFile, IncludePath),
output_context_for_java(Info ^ joi_foreign_line_numbers,
marker_begin_block, context(IncludePath, 1), !IO),
- write_include_file_contents_cur_stream(IncludePath, !IO),
+ write_include_file_contents_cur_stream(IncludePath, Res, !IO),
io.nl(!IO),
% We don't have the true end context readily available.
output_context_for_java(Info ^ joi_foreign_line_numbers,
marker_end_block, Context, !IO)
).
% Get the foreign code for Java.
%
:- func mlds_get_java_foreign_code(map(foreign_language, mlds_foreign_code))
= mlds_foreign_code.
@@ -487,34 +493,37 @@ output_env_var_definition_for_java(Indent, EnvVarName, !IO) :-
io.write_string(EnvVarName, !IO),
io.write_string("\") == null ? 0 : 1;\n", !IO).
%---------------------------------------------------------------------------%
%
% Code to output the start and end of a source file.
%
:- pred output_src_start_for_java(java_out_info::in, indent::in,
mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
- list(mlds_function_defn)::in, io::di, io::uo) is det.
+ list(mlds_function_defn)::in, list(string)::out, io::di, io::uo) is det.
output_src_start_for_java(Info, Indent, MercuryModuleName, Imports,
- ForeignDecls, FuncDefns, !IO) :-
+ ForeignDecls, FuncDefns, Errors, !IO) :-
output_auto_gen_comment(Info ^ joi_source_filename, !IO),
output_n_indents(Indent, !IO),
io.write_string("/* :- module ", !IO),
prog_out.write_sym_name(MercuryModuleName, !IO),
io.write_string(". */\n\n", !IO),
output_n_indents(Indent, !IO),
io.write_string("package jmercury;\n", !IO),
output_imports(Imports, !IO),
- io.write_list(ForeignDecls, "\n", output_java_decl(Info, Indent), !IO),
+ list.map_foldl(output_java_decl(Info, Indent),
+ ForeignDecls, ForeignDeclResults, !IO),
+ list.filter_map(maybe_is_error, ForeignDeclResults, Errors),
+
io.write_string("public class ", !IO),
mangle_sym_name_for_java(MercuryModuleName, module_qual, "__", ClassName),
io.write_string(ClassName, !IO),
io.write_string(" {\n", !IO),
output_debug_class_init(MercuryModuleName, "start", !IO),
% Check if this module contains a `main' predicate and if it does insert
% a `main' method in the resulting Java class that calls the `main'
% predicate.
--
2.18.0
More information about the reviews
mailing list