[m-rev.] for review: Move some code to new io.error_util module.
Peter Wang
novalazy at gmail.com
Fri Jan 13 17:08:15 AEDT 2023
This reduces the size of io.m a bit. The other reason for moving the
code is to allow modules that occur in a dependency cycle with io.m
to read results from io.error_util.trans_opt, whereas they may have
been prevented from reading io.trans_opt.
library/io.m:
library/io.error_util.m:
Move is_error, throw_on_error and other similar predicates to a
new undocumented submodule of io.m.
Also move the support functions/predicates used by those predicates.
Add forwarding predicates for the predicates that are part of the
io.m public interface.
library/MODULES_UNDOC:
library/library.m:
List the new submodule as undocumented.
library/benchmarking.m:
library/bitmap.m:
library/dir.m:
library/io.call_system.m:
library/io.file.m:
Import the new submodule.
---
library/MODULES_UNDOC | 1 +
library/benchmarking.m | 1 +
library/bitmap.m | 1 +
library/dir.m | 1 +
library/io.call_system.m | 1 +
library/io.error_util.m | 354 +++++++++++++++++++++++++++++++++++++++
library/io.file.m | 1 +
library/io.m | 334 +-----------------------------------
library/library.m | 2 +
9 files changed, 370 insertions(+), 326 deletions(-)
create mode 100644 library/io.error_util.m
diff --git a/library/MODULES_UNDOC b/library/MODULES_UNDOC
index d4d0c348a..2867ab0ab 100644
--- a/library/MODULES_UNDOC
+++ b/library/MODULES_UNDOC
@@ -1,4 +1,5 @@
backjump.m
+io.error_util.m
io.primitives_read.m
io.primitives_write.m
io.stream_db.m
diff --git a/library/benchmarking.m b/library/benchmarking.m
index 2277ffee0..b6e3f2992 100644
--- a/library/benchmarking.m
+++ b/library/benchmarking.m
@@ -229,6 +229,7 @@
:- implementation.
:- import_module int.
+:- import_module io.error_util.
:- import_module list.
:- import_module mutvar.
:- import_module require.
diff --git a/library/bitmap.m b/library/bitmap.m
index 643b230ff..74cb87139 100644
--- a/library/bitmap.m
+++ b/library/bitmap.m
@@ -552,6 +552,7 @@
:- import_module char.
:- import_module exception.
:- import_module int.
+:- import_module io.error_util.
:- import_module maybe.
:- import_module require.
:- import_module string.
diff --git a/library/dir.m b/library/dir.m
index 078e06085..3bf30925e 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -335,6 +335,7 @@
:- import_module char.
:- import_module exception.
:- import_module int.
+:- import_module io.error_util.
:- import_module io.file.
:- import_module maybe.
:- import_module require.
diff --git a/library/io.call_system.m b/library/io.call_system.m
index 90e5e8cd9..ef23c49a3 100644
--- a/library/io.call_system.m
+++ b/library/io.call_system.m
@@ -48,6 +48,7 @@
:- implementation.
+:- import_module io.error_util.
:- import_module string.
%---------------------------------------------------------------------------%
diff --git a/library/io.error_util.m b/library/io.error_util.m
new file mode 100644
index 000000000..6d2ceab50
--- /dev/null
+++ b/library/io.error_util.m
@@ -0,0 +1,354 @@
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2023 The Mercury team.
+% This file is distributed under the terms specified in COPYING.LIB.
+%---------------------------------------------------------------------------%
+%
+% File: io.error_util.m
+%
+% This module provides some predicates for dealing with I/O errors.
+%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- module io.error_util.
+:- interface.
+
+:- func no_error = system_error.
+
+ % is_error(Error, MessagePrefix, MaybeIOError, !IO):
+ % Returns `yes(IOError)' if Error indicates an error (not success).
+ %
+:- pred is_error(system_error::in, string::in, maybe(io.error)::out,
+ io::di, io::uo) is det.
+
+ % is_error_maybe_win32(Error, IsWin32Error, MessagePrefix, MaybeIOError,
+ % !IO):
+ % Same as is_error except that IsWin32Error is `yes' if Error originates
+ % from a Win32 system error code, `no' otherwise.
+ %
+:- pred is_error_maybe_win32(system_error::in, bool::in, string::in,
+ maybe(io.error)::out, io::di, io::uo) is det.
+
+:- pred make_io_error_from_system_error_impl(io.system_error::in, string::in,
+ io.error::out, io::di, io::uo) is det.
+
+:- pred make_io_error_from_windows_error_impl(io.system_error::in, string::in,
+ io.error::out, io::di, io::uo) is det.
+
+ % make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
+ % IOError, !IO):
+ % Helper to call either make_io_error_from_system_error_impl or
+ % make_io_error_from_windows_error_impl.
+ %
+:- pred make_io_error_from_maybe_win32_error(system_error::in, bool::in,
+ string::in, io.error::out, io::di, io::uo) is det.
+
+ % For use by bitmap.m, and other standard library modules
+ % that want to do I/O.
+ %
+:- pred throw_on_output_error(system_error::in, io::di, io::uo) is det.
+
+:- pred throw_on_close_error(system_error::in, io::di, io::uo) is det.
+
+:- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type system_error_style
+ ---> syserr_errno
+ ; syserr_errno_or_win32
+ ; syserr_exception_object.
+
+:- pragma foreign_export_enum("C", system_error_style/0,
+ [prefix("ML_"), uppercase]).
+:- pragma foreign_export_enum("C#", system_error_style/0,
+ [prefix("ML_"), uppercase]).
+:- pragma foreign_export_enum("Java", system_error_style/0,
+ [prefix("ML_"), uppercase]).
+
+:- func native_system_error_style = system_error_style.
+
+:- pragma foreign_proc("C",
+ native_system_error_style = (SysErrStyle::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+#ifdef MR_WIN32
+ SysErrStyle = ML_SYSERR_ERRNO_OR_WIN32;
+#else
+ SysErrStyle = ML_SYSERR_ERRNO;
+#endif
+").
+:- pragma foreign_proc("C#",
+ native_system_error_style = (SysErrStyle::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SysErrStyle = io.ML_SYSERR_EXCEPTION_OBJECT;
+").
+:- pragma foreign_proc("Java",
+ native_system_error_style = (SysErrStyle::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SysErrStyle = jmercury.io.ML_SYSERR_EXCEPTION_OBJECT;
+").
+
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ no_error = (Error::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Error = 0;
+").
+
+:- pragma foreign_proc("C#",
+ no_error = (Error::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Error = null;
+").
+
+:- pragma foreign_proc("Java",
+ no_error = (Error::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Error = null;
+").
+
+:- pred is_success(system_error::in) is semidet.
+:- pragma inline(pred(is_success/1)).
+
+:- pragma foreign_proc("C",
+ is_success(Error::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ // This works for errno and Win32 error values (ERROR_SUCCESS == 0).
+ SUCCESS_INDICATOR = (Error == 0) ? MR_TRUE : MR_FALSE;
+").
+
+:- pragma foreign_proc("C#",
+ is_success(Error::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = (Error == null);
+").
+
+:- pragma foreign_proc("Java",
+ is_success(Error::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = (Error == null);
+").
+
+:- pragma inline(pred(is_error/5)).
+
+is_error(Error, Prefix, MaybeError, !IO) :-
+ ( if is_success(Error) then
+ MaybeError = no
+ else
+ make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO),
+ MaybeError = yes(IOError)
+ ).
+
+is_error_maybe_win32(Error, IsWin32Error, Prefix, MaybeError, !IO) :-
+ ( if is_success(Error) then
+ MaybeError = no
+ else
+ make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
+ IOError, !IO),
+ MaybeError = yes(IOError)
+ ).
+
+%---------------------------------------------------------------------------%
+
+make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO) :-
+ SysErrStyle = native_system_error_style,
+ (
+ ( SysErrStyle = syserr_errno
+ ; SysErrStyle = syserr_errno_or_win32
+ ),
+ make_errno_message(Error, Prefix, Msg, !IO),
+ IOError = io_error_errno(Msg, Error)
+ ;
+ SysErrStyle = syserr_exception_object,
+ get_exception_object_message(Error, Msg0, !IO),
+ ( if Prefix = "" then
+ Msg = Msg0
+ else
+ Msg = Prefix ++ Msg0
+ ),
+ IOError = io_error_exception_object(Msg, Error)
+ ).
+
+make_io_error_from_windows_error_impl(Error, Prefix, IOError, !IO) :-
+ SysErrStyle = native_system_error_style,
+ (
+ SysErrStyle = syserr_errno_or_win32,
+ make_win32_error_message(Error, Prefix, Msg, !IO),
+ IOError = io_error_win32(Msg, Error)
+ ;
+ ( SysErrStyle = syserr_errno
+ ; SysErrStyle = syserr_exception_object
+ ),
+ error("io.error_util.make_io_error_from_windows_error: " ++
+ "inapplicable platform")
+ ).
+
+make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix, IOError,
+ !IO) :-
+ (
+ IsWin32Error = yes,
+ make_io_error_from_windows_error_impl(Error, Prefix, IOError, !IO)
+ ;
+ IsWin32Error = no,
+ make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO)
+ ).
+
+%---------------------------------------------------------------------------%
+
+:- pragma inline(pred(throw_on_output_error/3)).
+
+throw_on_output_error(Error, !IO) :-
+ throw_on_error(Error, "error writing to output file: ", !IO).
+
+throw_on_close_error(Error, !IO) :-
+ throw_on_error(Error, "error closing file: ", !IO).
+
+:- pragma inline(pred(throw_on_error/4)).
+
+throw_on_error(Error, Prefix, !IO) :-
+ % This follows the logic of is_error, but does not construct
+ % a MaybeError as an intermediate data structure.
+ ( if is_success(Error) then
+ true
+ else
+ make_io_error_from_system_error_impl(Error, Prefix, IOError, !IO),
+ throw(IOError)
+ ).
+
+%---------------------------------------------------------------------------%
+
+ % This requires the I/O state because the strerror/strerror_r functions
+ % depend on the current locale.
+ %
+:- pred make_errno_message(io.system_error::in, string::in, string::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ make_errno_message(Errno::in, Prefix::in, Msg::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+ char errbuf[MR_STRERROR_BUF_SIZE];
+ const char *errmsg;
+ size_t errmsg_len;
+ size_t prefix_len;
+
+ prefix_len = strlen(Prefix);
+ errmsg = MR_strerror(Errno, errbuf, sizeof(errbuf));
+ errmsg_len = strlen(errmsg);
+ MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len, MR_ALLOC_ID);
+ MR_memcpy(Msg, Prefix, prefix_len);
+ MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
+").
+
+make_errno_message(_, _, _, !IO) :-
+ error("io.error_util.make_errno_message: inapplicable back-end").
+
+%---------------------------------------------------------------------------%
+
+ % This requires the I/O state because the FormatMessage call depends
+ % on the current locale.
+ %
+ % XXX is FormatMessage thread-safe? Nothing suggests that it is not.
+ %
+:- pred make_win32_error_message(io.system_error::in, string::in, string::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ make_win32_error_message(ErrorCode::in, Prefix::in, Msg::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+#ifdef MR_WIN32
+ char *errmsg;
+ size_t errmsg_len;
+ size_t prefix_len;
+
+ if (FormatMessage(
+ FORMAT_MESSAGE_ALLOCATE_BUFFER
+ | FORMAT_MESSAGE_FROM_SYSTEM
+ | FORMAT_MESSAGE_IGNORE_INSERTS,
+ NULL,
+ ErrorCode,
+ MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+ (LPTSTR) &errmsg,
+ 0,
+ NULL) > 0)
+ {
+ // Remove trailing CR LF sequence.
+ char *cr = strchr(errmsg, '\\r');
+ if (cr != NULL) {
+ *cr = '\\0';
+ errmsg_len = (size_t) (cr - errmsg);
+ } else {
+ errmsg_len = strlen(errmsg);
+ }
+ prefix_len = strlen(Prefix);
+ MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len,
+ MR_ALLOC_ID);
+ MR_memcpy(Msg, Prefix, prefix_len);
+ MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
+ LocalFree(errmsg);
+ } else {
+ Msg = MR_make_string(MR_ALLOC_ID, ""%sSystem error 0x%X"",
+ Prefix, ErrorCode);
+ }
+#else
+ MR_fatal_error(""io.error_util.make_win32_error_message: not on Windows"");
+#endif
+").
+
+make_win32_error_message(_, _, _, !IO) :-
+ error("io.error_util.make_win32_error_message: inapplicable back-end").
+
+%---------------------------------------------------------------------------%
+
+ % This requires the I/O state because the exception message may be
+ % localised (at least for C#).
+ %
+:- pred get_exception_object_message(io.system_error::in, string::out,
+ io::di, io::uo) is det.
+
+:- pragma foreign_proc("C#",
+ get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+ if (Exception == null) {
+ Msg = ""null"";
+ } else {
+ Msg = Exception.Message;
+ }
+").
+:- pragma foreign_proc("Java",
+ get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
+"
+ if (Exception == null) {
+ Msg = ""null"";
+ } else {
+ Msg = Exception.getMessage();
+ if (Msg == null) {
+ Msg = ""null"";
+ }
+ }
+").
+
+get_exception_object_message(_, _, !IO) :-
+ error("io.error_util.get_exception_object_message: inapplicable back-end").
+
+%---------------------------------------------------------------------------%
+:- end_module io.error_util.
+%---------------------------------------------------------------------------%
diff --git a/library/io.file.m b/library/io.file.m
index e2c9d3994..ed464a726 100644
--- a/library/io.file.m
+++ b/library/io.file.m
@@ -221,6 +221,7 @@
:- implementation.
:- import_module io.environment.
+:- import_module io.error_util.
%---------------------------------------------------------------------------%
%
diff --git a/library/io.m b/library/io.m
index a49960412..a8402c429 100644
--- a/library/io.m
+++ b/library/io.m
@@ -2,7 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1993-2012 The University of Melbourne.
-% Copyright (C) 2013-2022 The Mercury team.
+% Copyright (C) 2013-2023 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
@@ -2229,6 +2229,7 @@
:- interface.
+:- include_module error_util.
:- include_module primitives_read. % Include exported for symmetry.
:- include_module primitives_write. % Include exported for benchmarking.m.
:- include_module stream_db. % Include exported for browser/browse.m.
@@ -2283,38 +2284,6 @@
:- func binary_input_stream_get_stream(binary_input_stream) = stream.
:- func binary_output_stream_get_stream(binary_output_stream) = stream.
-%---------------------%
-%
-% Error handling.
-%
-
- % is_error(Error, MessagePrefix, MaybeIOError, !IO):
- % Returns `yes(IOError)' if Error indicates an error (not success).
- %
-:- pred is_error(system_error::in, string::in, maybe(io.error)::out,
- io::di, io::uo) is det.
-
- % is_error_maybe_win32(Error, IsWin32Error, MessagePrefix, MaybeIOError,
- % !IO):
- % Same as is_error except that IsWin32Error is `yes' if Error originates
- % from a Win32 system error code, `no' otherwise.
- %
-:- pred is_error_maybe_win32(system_error::in, bool::in, string::in,
- maybe(io.error)::out, io::di, io::uo) is det.
-
- % make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
- % IOError, !IO):
- % Helper to call either make_io_error_from_system_error or
- % make_io_error_from_windows_error.
- %
-:- pred make_io_error_from_maybe_win32_error(system_error::in, bool::in,
- string::in, io.error::out, io::di, io::uo) is det.
-
- % For use by bitmap.m, and other standard library modules
- % that want to do I/O.
- %
-:- pred throw_on_output_error(system_error::in, io::di, io::uo) is det.
-
%---------------------%
%
% For use by the compiler transformation that implements trace [io(!IO)].
@@ -2347,6 +2316,7 @@
:- import_module int64.
:- import_module io.call_system.
:- import_module io.environment.
+:- import_module io.error_util.
:- import_module io.file.
:- import_module io.primitives_read.
:- import_module io.primitives_write.
@@ -4926,36 +4896,12 @@ report_tabling_statistics(!IO) :-
make_io_error(Error) = io_error_string(Error).
make_io_error_from_system_error(Error, Prefix, IOError, !IO) :-
- SysErrStyle = native_system_error_style,
- (
- ( SysErrStyle = syserr_errno
- ; SysErrStyle = syserr_errno_or_win32
- ),
- make_errno_message(Error, Prefix, Msg, !IO),
- IOError = io_error_errno(Msg, Error)
- ;
- SysErrStyle = syserr_exception_object,
- get_exception_object_message(Error, Msg0, !IO),
- ( if Prefix = "" then
- Msg = Msg0
- else
- Msg = Prefix ++ Msg0
- ),
- IOError = io_error_exception_object(Msg, Error)
- ).
+ io.error_util.make_io_error_from_system_error_impl(Error, Prefix, IOError,
+ !IO).
make_io_error_from_windows_error(Error, Prefix, IOError, !IO) :-
- SysErrStyle = native_system_error_style,
- (
- SysErrStyle = syserr_errno_or_win32,
- make_win32_error_message(Error, Prefix, Msg, !IO),
- IOError = io_error_win32(Msg, Error)
- ;
- ( SysErrStyle = syserr_errno
- ; SysErrStyle = syserr_exception_object
- ),
- error("io.make_io_error_from_windows_error: inapplicable platform")
- ).
+ io.error_util.make_io_error_from_windows_error_impl(Error, Prefix, IOError,
+ !IO).
%---------------------%
@@ -5754,14 +5700,11 @@ stream_whence_to_io_whence(end) = end.
% Error handling.
%
% The predicates interpreting result codes ought to stay in io.m,
-% because moving them to e.g. new io.error.m submodule would prevent them
+% because moving them to e.g. io.error_util.m would prevent them
% from being inlined into their call sites above at low optimization levels,
% and some of those call sites (e.g. in read_char) can be expected to be
% heavily used in some programs.
%
-% The rest of the error handling code below is not big enough to warrant
-% a module of its own.
-%
:- type result_code
---> result_code_ok
@@ -5846,267 +5789,6 @@ interpret_maybe_incomplete_result_code(ResultCode, Error, IncompleteBytes,
Result = error(IOError)
).
-%---------------------%
-
-:- type system_error_style
- ---> syserr_errno
- ; syserr_errno_or_win32
- ; syserr_exception_object.
-
-:- pragma foreign_export_enum("C", system_error_style/0,
- [prefix("ML_"), uppercase]).
-:- pragma foreign_export_enum("C#", system_error_style/0,
- [prefix("ML_"), uppercase]).
-:- pragma foreign_export_enum("Java", system_error_style/0,
- [prefix("ML_"), uppercase]).
-
-:- func native_system_error_style = system_error_style.
-
-:- pragma foreign_proc("C",
- native_system_error_style = (SysErrStyle::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
-#ifdef MR_WIN32
- SysErrStyle = ML_SYSERR_ERRNO_OR_WIN32;
-#else
- SysErrStyle = ML_SYSERR_ERRNO;
-#endif
-").
-:- pragma foreign_proc("C#",
- native_system_error_style = (SysErrStyle::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SysErrStyle = io.ML_SYSERR_EXCEPTION_OBJECT;
-").
-:- pragma foreign_proc("Java",
- native_system_error_style = (SysErrStyle::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SysErrStyle = jmercury.io.ML_SYSERR_EXCEPTION_OBJECT;
-").
-
-%---------------------%
-
-:- func no_error = system_error.
-
-:- pragma foreign_proc("C",
- no_error = (Error::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Error = 0;
-").
-
-:- pragma foreign_proc("C#",
- no_error = (Error::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Error = null;
-").
-
-:- pragma foreign_proc("Java",
- no_error = (Error::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- Error = null;
-").
-
-:- pred is_success(system_error::in) is semidet.
-:- pragma inline(pred(is_success/1)).
-
-:- pragma foreign_proc("C",
- is_success(Error::in),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- // This works for errno and Win32 error values (ERROR_SUCCESS == 0).
- SUCCESS_INDICATOR = (Error == 0) ? MR_TRUE : MR_FALSE;
-").
-
-:- pragma foreign_proc("C#",
- is_success(Error::in),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SUCCESS_INDICATOR = (Error == null);
-").
-
-:- pragma foreign_proc("Java",
- is_success(Error::in),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SUCCESS_INDICATOR = (Error == null);
-").
-
-:- pragma inline(pred(is_error/5)).
-
-is_error(Error, Prefix, MaybeError, !IO) :-
- ( if is_success(Error) then
- MaybeError = no
- else
- make_io_error_from_system_error(Error, Prefix, IOError, !IO),
- MaybeError = yes(IOError)
- ).
-
-is_error_maybe_win32(Error, IsWin32Error, Prefix, MaybeError, !IO) :-
- ( if is_success(Error) then
- MaybeError = no
- else
- make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix,
- IOError, !IO),
- MaybeError = yes(IOError)
- ).
-
-make_io_error_from_maybe_win32_error(Error, IsWin32Error, Prefix, IOError,
- !IO) :-
- (
- IsWin32Error = yes,
- make_io_error_from_windows_error(Error, Prefix, IOError, !IO)
- ;
- IsWin32Error = no,
- make_io_error_from_system_error(Error, Prefix, IOError, !IO)
- ).
-
-:- pragma inline(pred(throw_on_output_error/3)).
-
-throw_on_output_error(Error, !IO) :-
- throw_on_error(Error, "error writing to output file: ", !IO).
-
-:- pred throw_on_close_error(system_error::in, io::di, io::uo) is det.
-
-throw_on_close_error(Error, !IO) :-
- throw_on_error(Error, "error closing file: ", !IO).
-
-:- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
-:- pragma inline(pred(throw_on_error/4)).
-
-throw_on_error(Error, Prefix, !IO) :-
- % This follows the logic of is_error, but does not construct
- % a MaybeError as an intermediate data structure.
- ( if is_success(Error) then
- true
- else
- make_io_error_from_system_error(Error, Prefix, IOError, !IO),
- throw(IOError)
- ).
-
-%---------------------------------------------------------------------------%
-
- % This requires the I/O state because the strerror/strerror_r functions
- % depend on the current locale.
- %
-:- pred make_errno_message(io.system_error::in, string::in, string::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- make_errno_message(Errno::in, Prefix::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
- char errbuf[MR_STRERROR_BUF_SIZE];
- const char *errmsg;
- size_t errmsg_len;
- size_t prefix_len;
-
- prefix_len = strlen(Prefix);
- errmsg = MR_strerror(Errno, errbuf, sizeof(errbuf));
- errmsg_len = strlen(errmsg);
- MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len, MR_ALLOC_ID);
- MR_memcpy(Msg, Prefix, prefix_len);
- MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
-").
-
-make_errno_message(_, _, _, !IO) :-
- error("io.make_errno_message: inapplicable back-end").
-
-%---------------------%
-
- % This requires the I/O state because the FormatMessage call depends
- % on the current locale.
- %
- % XXX is FormatMessage thread-safe? Nothing suggests that it is not.
- %
-:- pred make_win32_error_message(io.system_error::in, string::in, string::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
- make_win32_error_message(ErrorCode::in, Prefix::in, Msg::out,
- _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
-#ifdef MR_WIN32
- char *errmsg;
- size_t errmsg_len;
- size_t prefix_len;
-
- if (FormatMessage(
- FORMAT_MESSAGE_ALLOCATE_BUFFER
- | FORMAT_MESSAGE_FROM_SYSTEM
- | FORMAT_MESSAGE_IGNORE_INSERTS,
- NULL,
- ErrorCode,
- MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
- (LPTSTR) &errmsg,
- 0,
- NULL) > 0)
- {
- // Remove trailing CR LF sequence.
- char *cr = strchr(errmsg, '\\r');
- if (cr != NULL) {
- *cr = '\\0';
- errmsg_len = (size_t) (cr - errmsg);
- } else {
- errmsg_len = strlen(errmsg);
- }
- prefix_len = strlen(Prefix);
- MR_allocate_aligned_string_msg(Msg, prefix_len + errmsg_len,
- MR_ALLOC_ID);
- MR_memcpy(Msg, Prefix, prefix_len);
- MR_memcpy(Msg + prefix_len, errmsg, errmsg_len + 1); // include NUL
- LocalFree(errmsg);
- } else {
- Msg = MR_make_string(MR_ALLOC_ID, ""%sSystem error 0x%X"",
- Prefix, ErrorCode);
- }
-#else
- MR_fatal_error(""io.make_win32_error_message: not on Windows"");
-#endif
-").
-
-make_win32_error_message(_, _, _, !IO) :-
- error("io.make_win32_error_message: inapplicable back-end").
-
-%---------------------%
-
- % This requires the I/O state because the exception message may be
- % localised (at least for C#).
- %
-:- pred get_exception_object_message(io.system_error::in, string::out,
- io::di, io::uo) is det.
-
-:- pragma foreign_proc("C#",
- get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
- if (Exception == null) {
- Msg = ""null"";
- } else {
- Msg = Exception.Message;
- }
-").
-:- pragma foreign_proc("Java",
- get_exception_object_message(Exception::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, thread_safe, may_not_export_body],
-"
- if (Exception == null) {
- Msg = ""null"";
- } else {
- Msg = Exception.getMessage();
- if (Msg == null) {
- Msg = ""null"";
- }
- }
-").
-
-get_exception_object_message(_, _, !IO) :-
- error("io.get_exception_object_message: inapplicable back-end").
-
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
diff --git a/library/library.m b/library/library.m
index aac5cfabc..d5bd03403 100644
--- a/library/library.m
+++ b/library/library.m
@@ -122,6 +122,7 @@
:- import_module io.
:- import_module io.call_system.
:- import_module io.environment.
+:- import_module io.error_util.
:- import_module io.file.
:- import_module io.primitives_read.
:- import_module io.primitives_write.
@@ -309,6 +310,7 @@ stdlib_module_doc_undoc("integer", doc).
stdlib_module_doc_undoc("io", doc).
stdlib_module_doc_undoc("io.call_system", doc).
stdlib_module_doc_undoc("io.environment", doc).
+stdlib_module_doc_undoc("io.error_util", undoc).
stdlib_module_doc_undoc("io.file", doc).
stdlib_module_doc_undoc("io.primitives_read", undoc).
stdlib_module_doc_undoc("io.primitives_write", undoc).
--
2.39.0
More information about the reviews
mailing list