[m-rev.] for review: Reduce use of foreign-exported procs in dir.m.
Peter Wang
novalazy at gmail.com
Wed Oct 5 11:59:46 AEDT 2016
Reduce use of foreign-exported procs in dir.m.
library/io.m:
Note that io.system_error sometimes takes on Win32 error values.
Remove I/O state arguments on `make_err_msg' and
`make_maybe_win32_err_msg'.
Remove `was_error' argument from `ML_maybe_make_err_msg' and
`ML_maybe_make_win32_err_msg' macros, and rename the macros.
Simplify the macros using `MR_allocate_aligned_string_msg' instead of
`MR_offset_incr_hp_atomic_msg'.
Add `is_maybe_win32_error'.
Write `is_error' and `is_maybe_win32_error' in terms of `make_err_msg'
and `make_maybe_win32_err_msg'.
Add `thread_safe' attributes to some `make_err_msg' implementations.
Delete obsolete foreign exported predicates.
library/dir.m:
Simplify `current_directory' implementations. Avoid calling back
into Mercury from foreign code.
Separate out a code path `make_directory_including_parents' from
`make_directory', for C# and Java backends to override instead of
overriding `make_directory' directly. Avoid calling back into Mercury
from foreign code.
Delete the Erlang override of `make_directory'; just use the generic
implementation.
Simplify `make_single_directory'. Avoid calling back into Mercury
from foreign code.
Reduce use of bare ints between Mercury and foreign procs.
Catch exceptions in Java `read_entry_2'.
Delete many obsolete foreign exported predicates.
mdbcomp/program_representation.m:
Conform to change.
diff --git a/library/dir.m b/library/dir.m
index 935934d..a3c4e87 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1994-1995,1997,1999-2000,2002-2012 The University of Melbourne.
+% Copyright (C) 2016 The Mercury team.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%---------------------------------------------------------------------------%
@@ -324,11 +325,6 @@ ends_with_directory_separator(String, End, PrevIndex) :-
use_windows_paths :- dir.directory_separator = ('\\').
-:- pragma foreign_export("C", (dir.this_directory = out),
- "ML_dir_this_directory").
-:- pragma foreign_export("C#", (dir.this_directory = out),
- "ML_dir_this_directory").
-
this_directory = ".".
this_directory(dir.this_directory).
@@ -784,8 +780,6 @@ make_path_name(DirName, FileName) = DirName/FileName.
:- pragma foreign_export("C", dir.make_path_name(in, in) = out,
"ML_make_path_name").
-:- pragma foreign_export("C#", dir.make_path_name(in, in) = out,
- "ML_make_path_name").
DirName0/FileName0 = PathName :-
DirName = string.from_char_list(canonicalize_path_chars(
@@ -853,50 +847,48 @@ relative_path_name_from_components(Components) = PathName :-
%---------------------------------------------------------------------------%
+current_directory(Res, !IO) :-
+ current_directory_2(CurDir, Error, !IO),
+ ( if is_error(Error, "dir.current_directory failed: ", IOError) then
+ Res = error(IOError)
+ else
+ Res = ok(CurDir)
+ ).
+
+:- pred current_directory_2(string::out, io.system_error::out, io::di, io::uo)
+ is det.
+
:- pragma foreign_proc("C",
- dir.current_directory(Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
may_not_duplicate],
"
- /*
- ** Marked thread_safe because ML_make_io_res_1_error_string will acquire
- ** the global lock.
- */
-
#ifdef MR_WIN32
wchar_t *wbuf;
MR_String str;
wbuf = _wgetcwd(NULL, 1);
if (wbuf != NULL) {
- str = ML_wide_to_utf8(wbuf, MR_ALLOC_ID);
- Res = ML_make_io_res_1_ok_string(str);
+ CurDir = ML_wide_to_utf8(wbuf, MR_ALLOC_ID);
+ Error = 0;
free(wbuf);
} else {
- ML_make_io_res_1_error_string(errno,
- MR_make_string_const(""dir.current_directory failed: ""),
- &Res);
+ CurDir = MR_make_string_const("""");
+ Error = errno;
}
#else
size_t size = 256;
- MR_Word ptr;
- char *buf;
- MR_String str;
while (1) {
- MR_offset_incr_hp_atomic_msg(ptr, 0,
- (size + sizeof(MR_Word) - 1) / sizeof(MR_Word),
- MR_ALLOC_ID, ""string.string/0"");
- buf = (char *) ptr;
- if (getcwd(buf, size)) {
- MR_make_aligned_string(str, buf);
- Res = ML_make_io_res_1_ok_string(str);
+ /* `size' includes the NUL terminator. */
+ MR_allocate_aligned_string_msg(CurDir, size - 1, MR_ALLOC_ID);
+ if (getcwd(CurDir, size)) {
+ Error = 0;
break;
}
if (errno != ERANGE) {
- ML_make_io_res_1_error_string(errno,
- MR_make_string_const(""dir.current_directory failed: ""),
- &Res);
+ CurDir = MR_make_string_const("""");
+ Error = errno;
break;
}
/* Buffer too small. Resize and try again. */
@@ -906,380 +898,389 @@ relative_path_name_from_components(Components) = PathName :-
").
:- pragma foreign_proc("C#",
- dir.current_directory(Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
may_not_duplicate],
"
try {
- string dir = System.IO.Directory.GetCurrentDirectory();
- Res = io.ML_make_io_res_1_ok_string(dir);
+ CurDir = System.IO.Directory.GetCurrentDirectory();
+ Error = null;
} catch (System.Exception e) {
- Res = io.ML_make_io_res_1_error_string(e,
- ""dir.current_directory failed: "");
+ CurDir = """";
+ Error = e;
}
").
:- pragma foreign_proc("Java",
- dir.current_directory(Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
may_not_duplicate],
"
+ try {
java.io.File dir = new java.io.File(""."");
- try {
- Res = io.ML_make_io_res_1_ok_string(dir.getCanonicalPath());
- } catch (Exception e) {
- Res = io.ML_make_io_res_1_error_string(e,
- ""dir.current_directory failed: "");
+ CurDir = dir.getCanonicalPath();
+ Error = null;
+ } catch (java.lang.Exception e) {
+ CurDir = """";
+ Error = e;
}
").
:- pragma foreign_proc("Erlang",
- dir.current_directory(Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
+ current_directory_2(CurDir::out, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
case file:get_cwd() of
{ok, Cwd} ->
- Res = mercury__io:'ML_make_io_res_1_ok_string'(
- list_to_binary(Cwd));
+ CurDir = list_to_binary(Cwd),
+ Error = ok;
{error, Reason} ->
- Res = mercury__io:'ML_make_io_res_1_error_string'(Reason,
- ""dir.current_directory failed: "")
+ CurDir = <<>>,
+ Error = {error, Reason}
end
").
%---------------------------------------------------------------------------%
make_directory(PathName, Result, !IO) :-
- ( if can_implement_make_directory then
+ ( if have_make_directory_including_parents then
+ make_directory_including_parents(PathName, Result, !IO)
+ else
DirName = dir.dirname(PathName),
( if PathName = DirName then
% We've been asked to make a root directory -- the mkdir will fail.
- dir.make_single_directory_2(0, PathName, Result, !IO)
+ make_directory_or_check_exists(PathName, Result, !IO)
else if DirName = dir.this_directory then
% Just go ahead and attempt to make the directory -- if the
% current directory is not accessible, the mkdir will fail.
- dir.make_single_directory_2(0, PathName, Result, !IO)
+ make_directory_or_check_exists(PathName, Result, !IO)
else
- io.check_file_accessibility(DirName, [],
- ParentAccessResult, !IO),
+ io.check_file_accessibility(DirName, [], ParentAccessResult, !IO),
(
ParentAccessResult = ok,
- dir.make_single_directory_2(0, PathName, Result, !IO)
+ make_directory_or_check_exists(PathName, Result, !IO)
;
ParentAccessResult = error(_),
- dir.make_directory(DirName, ParentResult, !IO),
+ make_directory(DirName, ParentResult, !IO),
(
ParentResult = ok,
- dir.make_single_directory_2(0, PathName, Result, !IO)
+ make_directory_or_check_exists(PathName, Result, !IO)
;
ParentResult = error(_),
Result = ParentResult
)
)
)
+ ).
+
+:- pred make_directory_or_check_exists(string::in, io.res::out, io::di, io::uo)
+ is det.
+
+make_directory_or_check_exists(DirName, Res, !IO) :-
+ make_single_directory_2(DirName, Res0, MaybeWin32Error, !IO),
+ (
+ Res0 = ok,
+ Res = ok
+ ;
+ Res0 = name_exists,
+ io.file_type(yes, DirName, TypeRes, !IO),
+ ( if TypeRes = ok(directory) then
+ check_dir_accessibility(DirName, Res, !IO)
+ else
+ make_maybe_win32_err_msg(MaybeWin32Error,
+ "cannot create directory: ", Message),
+ Res = error(make_io_error(Message))
+ )
+ ;
+ Res0 = dir_exists,
+ check_dir_accessibility(DirName, Res, !IO)
+ ;
+ Res0 = error,
+ make_maybe_win32_err_msg(MaybeWin32Error,
+ "cannot create directory: ", Message),
+ Res = error(make_io_error(Message))
+ ).
+
+:- pred check_dir_accessibility(string::in, io.res::out, io::di, io::uo)
+ is det.
+
+check_dir_accessibility(DirName, Res, !IO) :-
+ % Check whether we can read and write the directory.
+ io.check_file_accessibility(DirName, [read, write, execute], Res, !IO).
+
+%---------------------------------------------------------------------------%
+
+:- pred have_make_directory_including_parents is semidet.
+
+have_make_directory_including_parents :-
+ semidet_fail.
+
+:- pragma foreign_proc("C#",
+ have_make_directory_including_parents,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = true;
+").
+:- pragma foreign_proc("Java",
+ have_make_directory_including_parents,
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = true;
+").
+
+:- pred make_directory_including_parents(string::in, io.res::out,
+ io::di, io::uo) is det.
+
+make_directory_including_parents(DirName, Res, !IO) :-
+ make_directory_including_parents_2(DirName, Error, CheckAccess, !IO),
+ ( if is_error(Error, "cannot make directory: ", IOError) then
+ Res = error(IOError)
else
- Result = error(make_io_error(
- "dir.make_directory not implemented on this platform"))
+ (
+ CheckAccess = yes,
+ check_dir_accessibility(DirName, Res, !IO)
+ ;
+ CheckAccess = no,
+ Res = ok
+ )
).
-% The .NET CLI library function System.IO.Directory.CreateDirectory()
-% creates the entire path in one call.
+:- pred make_directory_including_parents_2(string::in, io.system_error::out,
+ bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+ make_directory_including_parents_2(_DirName::in, Error::out,
+ CheckAccess::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+ Error = ENOSYS;
+ CheckAccess = MR_NO;
+").
+
:- pragma foreign_proc("C#",
- dir.make_directory(DirName::in, Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
-"{
+ make_directory_including_parents_2(DirName::in, Error::out,
+ CheckAccess::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
try {
- // CreateDirectory doesn't fail if a file with the same
- // name as the directory being created already exists.
+ // System.IO.Directory.CreateDirectory() creates all directories and
+ // subdirectories in the specified path unless they already exist.
+
+ // CreateDirectory() doesn't fail if a file with the same name as the
+ // directory being created already exists.
if (System.IO.File.Exists(DirName)) {
- Res = dir.ML_make_mkdir_res_error(
- new System.Exception(""a file with that name already exists""));
+ Error =
+ new System.Exception(""a file with that name already exists"");
+ CheckAccess = mr_bool.NO;
} else if (System.IO.Directory.Exists(DirName)) {
- Res = dir.ML_check_dir_accessibility(DirName);
+ Error = null;
+ CheckAccess = mr_bool.YES;
} else {
System.IO.Directory.CreateDirectory(DirName);
- Res = dir.ML_make_mkdir_res_ok();
+ Error = null;
+ CheckAccess = mr_bool.NO;
}
} catch (System.Exception e) {
- Res = dir.ML_make_mkdir_res_error(e);
+ Error = e;
+ CheckAccess = mr_bool.NO;
}
-}").
+").
-% Java has a similar library function java.io.File.mkdirs()
:- pragma foreign_proc("Java",
- dir.make_directory(DirName::in, Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
- may_not_duplicate],
+ make_directory_including_parents_2(DirName::in, Error::out,
+ CheckAccess::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
try {
java.io.File dir = new java.io.File(DirName);
if (dir.isFile()) {
- throw new java.lang.RuntimeException(
+ Error = new java.lang.RuntimeException(
""a file with that name already exists"");
- }
- if (dir.isDirectory()) {
- Res = ML_check_dir_accessibility(DirName);
+ CheckAccess = bool.NO;
+ } else if (dir.isDirectory()) {
+ Error = null;
+ CheckAccess = bool.YES;
+ } else if (dir.mkdirs()) {
+ Error = null;
+ CheckAccess = bool.NO;
} else {
- if (!dir.mkdirs()) {
- throw new java.lang.RuntimeException(
- ""make_directory failed"");
- }
- Res = make_mkdir_res_ok_0_f_0();
+ Error = new java.lang.RuntimeException(""make_directory failed"");
+ CheckAccess = bool.NO;
}
} catch (java.lang.Exception e) {
- Res = ML_make_mkdir_res_error(e);
+ Error = e;
+ CheckAccess = bool.NO;
}
").
-:- pragma foreign_proc("Erlang",
- dir.make_directory(DirName::in, Res::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
-"
- DirNameStr = binary_to_list(DirName),
- % filelib:ensure_dir makes all the parent directories.
- case filelib:ensure_dir(DirNameStr) of
- ok ->
- ErrorIfExists = 0,
- Res = mercury__dir:'ML_make_single_directory_2'(ErrorIfExists,
- DirName); % not DirNameStr
- {error, Reason} ->
- Res = mercury__dir:'ML_make_mkdir_res_error'(Reason)
- end
-").
-
-:- pred can_implement_make_directory is semidet.
-
-can_implement_make_directory :-
- semidet_fail.
-
-:- pragma foreign_proc("C",
- can_implement_make_directory,
- [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
- does_not_affect_liveness],
-"
-#if defined(MR_WIN32)
- SUCCESS_INDICATOR = MR_TRUE;
-#elif defined(MR_HAVE_MKDIR)
- SUCCESS_INDICATOR = MR_TRUE;
-#else
- SUCCESS_INDICATOR = MR_FALSE;
-#endif
-").
-:- pragma foreign_proc("C#",
- can_implement_make_directory,
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SUCCESS_INDICATOR = true;
-"
-).
-:- pragma foreign_proc("Java",
- can_implement_make_directory,
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SUCCESS_INDICATOR = true;
-"
-).
-:- pragma foreign_proc("Erlang",
- can_implement_make_directory,
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- SUCCESS_INDICATOR = true
-").
+%---------------------------------------------------------------------------%
make_single_directory(DirName, Result, !IO) :-
- dir.make_single_directory_2(1, DirName, Result, !IO).
+ make_single_directory_2(DirName, Status, MaybeWin32Error, !IO),
+ (
+ Status = ok,
+ Result = ok
+ ;
+ ( Status = name_exists
+ ; Status = dir_exists
+ ; Status = error
+ ),
+ make_maybe_win32_err_msg(MaybeWin32Error, "cannot create directory: ",
+ Message),
+ Result = error(make_io_error(Message))
+ ).
-:- pragma foreign_export("Erlang",
- dir.make_single_directory_2(in, in, out, di, uo),
- "ML_make_single_directory_2").
+:- type make_single_directory_status
+ ---> ok
+ ; name_exists % may or may not be directory
+ ; dir_exists
+ ; error.
-:- pred dir.make_single_directory_2(int::in, string::in, io.res::out,
- io::di, io::uo) is det.
+:- pragma foreign_export_enum("C", make_single_directory_status/0,
+ [prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
+:- pragma foreign_export_enum("C#", make_single_directory_status/0,
+ [prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
+:- pragma foreign_export_enum("Java", make_single_directory_status/0,
+ [prefix("ML_MAKE_SINGLE_DIRECTORY_"), uppercase]).
+
+:- pred make_single_directory_2(string::in, make_single_directory_status::out,
+ io.system_error::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- dir.make_single_directory_2(ErrorIfExists::in, DirName::in,
- Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
- terminates, will_not_modify_trail, does_not_affect_liveness,
- may_not_duplicate],
+ make_single_directory_2(DirName::in, Status::out, Error::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+ will_not_modify_trail, does_not_affect_liveness, may_not_duplicate],
"
#if defined(MR_WIN32)
if (CreateDirectoryW(ML_utf8_to_wide(DirName), NULL)) {
- Result = ML_make_mkdir_res_ok();
+ Status = ML_MAKE_SINGLE_DIRECTORY_OK;
+ Error = 0;
} else {
- int error;
-
- error = GetLastError();
- if (!ErrorIfExists && error == ERROR_ALREADY_EXISTS) {
- ML_make_mkdir_res_exists(error, DirName, &Result);
+ Error = GetLastError();
+ if (Error == ERROR_ALREADY_EXISTS) {
+ Status = ML_MAKE_SINGLE_DIRECTORY_NAME_EXISTS;
} else {
- ML_make_mkdir_res_error(error, &Result);
+ Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
}
}
#elif defined(MR_HAVE_MKDIR)
if (mkdir(DirName, 0777) == 0) {
- Result = ML_make_mkdir_res_ok();
+ Status = ML_MAKE_SINGLE_DIRECTORY_OK;
+ Error = 0;
+ } else {
+ Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = errno;
#ifdef EEXIST
- } else if (!ErrorIfExists && errno == EEXIST) {
- ML_make_mkdir_res_exists(errno, DirName, &Result);
+ if (Error == EEXIST) {
+ Status = ML_MAKE_SINGLE_DIRECTORY_NAME_EXISTS;
+ }
#endif /* EEXIST */
- } else {
- ML_make_mkdir_res_error(errno, &Result);
}
#else /* !MR_WIN32 && !MR_HAVE_MKDIR */
- MR_fatal_error(
- ""dir.make_single_directory_2 called but not supported"");
+ Status = ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = ENOSYS;
#endif
").
+
:- pragma foreign_proc("C#",
- dir.make_single_directory_2(ErrorIfExists::in, DirName::in,
- Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
-"{
+ make_single_directory_2(DirName::in, Status::out, Error::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
try {
- // CreateDirectory doesn't fail if a file with the same
- // name as the directory being created already exists.
+ // DirectoryInfo.Create doesn't fail if a file with the same name as
+ // the directory being created already exists.
if (System.IO.File.Exists(DirName)) {
- Result = dir.ML_make_mkdir_res_error(
- new System.Exception(
- ""a file with that name already exists""));
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = new System.Exception(
+ ""a file with that name already exists"");
} else {
System.IO.DirectoryInfo info =
new System.IO.DirectoryInfo(DirName);
System.IO.DirectoryInfo parent_info = info.Parent;
+ // Not sure why we need these first two tests.
if (parent_info == null) {
- Result = dir.ML_make_mkdir_res_error(
- new System.Exception(""can't create root directory""));
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = new System.Exception(""can't create root directory"");
} else if (!info.Parent.Exists) {
- Result = dir.ML_make_mkdir_res_error(
- new System.Exception(""parent directory does not exist""));
- } else if (ErrorIfExists == 1 && info.Exists) {
- Result = dir.ML_make_mkdir_res_error(
- new System.Exception(""directory already exists""));
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error =
+ new System.Exception(""parent directory does not exist"");
+ } else if (info.Exists) {
+ // DirectoryInfo.Create does nothing if the directory already
+ // exists, so we check explicitly. There is a race here.
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_DIR_EXISTS;
+ Error = new System.Exception(""directory already exists"");
} else {
info.Create();
- Result = dir.ML_make_mkdir_res_ok();
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_OK;
+ Error = null;
}
}
} catch (System.Exception e) {
- Result = dir.ML_make_mkdir_res_error(e);
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = e;
}
-}").
+").
:- pragma foreign_proc("Java",
- dir.make_single_directory_2(ErrorIfExists::in, DirName::in,
- Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ make_single_directory_2(DirName::in, Status::out, Error::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
may_not_duplicate],
"
try {
java.io.File newDir = new java.io.File(DirName);
java.io.File parent = newDir.getParentFile();
+ // Are these first two checks just to produce better error messages?
if (parent == null) {
- Result = ML_make_mkdir_res_error(
- new java.io.IOException(""can't create root directory""));
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = new java.io.IOException(""can't create root directory"");
} else if (!parent.exists()) {
- Result = ML_make_mkdir_res_error(
- new java.io.IOException(""parent directory does not exist""));
- } else if (ErrorIfExists == 1 && newDir.exists()) {
- Result = ML_make_mkdir_res_error(
- new java.io.IOException(""directory already exists""));
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error =
+ new java.io.IOException(""parent directory does not exist"");
+ } else if (newDir.isDirectory()) {
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_DIR_EXISTS;
+ Error = new java.io.IOException(""directory already exists"");
} else {
- if (!newDir.mkdir()) {
- throw new java.lang.RuntimeException(
- ""make_single_directory failed"");
+ if (newDir.mkdir()) {
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_OK;
+ Error = null;
+ } else {
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = new java.io.IOException(""mkdir failed"");
}
- Result = ML_make_mkdir_res_ok();
}
} catch (java.lang.Exception e) {
- Result = ML_make_mkdir_res_error(e);
+ Status = dir.ML_MAKE_SINGLE_DIRECTORY_ERROR;
+ Error = e;
}
").
:- pragma foreign_proc("Erlang",
- dir.make_single_directory_2(ErrorIfExists::in, DirName::in,
- Result::out, _IO0::di, _IO::uo),
- [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
+ make_single_directory_2(DirName::in, Status::out, Error::out,
+ _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+ may_not_duplicate],
"
DirNameStr = binary_to_list(DirName),
case file:make_dir(DirNameStr) of
ok ->
- Result = mercury__dir:'ML_make_mkdir_res_ok'();
- {error, eexist} when ErrorIfExists =:= 0 ->
- Result = mercury__dir:'ML_make_mkdir_res_exists'(eexist,
- DirName); % not DirNameStr
+ Status = {ok},
+ Error = ok;
+ {error, eexist} ->
+ Status = {name_exists},
+ Error = {error, eexist};
{error, Reason} ->
- Result = mercury__dir:'ML_make_mkdir_res_error'(Reason)
+ Status = {error},
+ Error = {error, Reason}
end
").
-:- func dir.make_mkdir_res_ok = io.res.
-:- pragma foreign_export("C", (dir.make_mkdir_res_ok = out),
- "ML_make_mkdir_res_ok").
-:- pragma foreign_export("C#", (dir.make_mkdir_res_ok = out),
- "ML_make_mkdir_res_ok").
-:- pragma foreign_export("Java", (dir.make_mkdir_res_ok = out),
- "ML_make_mkdir_res_ok").
-:- pragma foreign_export("Erlang", (dir.make_mkdir_res_ok = out),
- "ML_make_mkdir_res_ok").
-
-make_mkdir_res_ok = ok.
-
-:- pred dir.make_mkdir_res_error(io.system_error::in, io.res::out,
- io::di, io::uo) is det.
-:- pragma foreign_export("C", dir.make_mkdir_res_error(in, out, di, uo),
- "ML_make_mkdir_res_error").
-:- pragma foreign_export("C#", dir.make_mkdir_res_error(in, out, di, uo),
- "ML_make_mkdir_res_error").
-:- pragma foreign_export("Java", dir.make_mkdir_res_error(in, out, di, uo),
- "ML_make_mkdir_res_error").
-:- pragma foreign_export("Erlang", dir.make_mkdir_res_error(in, out, di, uo),
- "ML_make_mkdir_res_error").
-
-make_mkdir_res_error(Error, error(make_io_error(Msg)), !IO) :-
- io.make_maybe_win32_err_msg(Error, "dir.make_directory failed: ",
- Msg, !IO).
-
-:- pred dir.make_mkdir_res_exists(io.system_error::in,
- string::in, io.res::out, io::di, io::uo) is det.
-:- pragma foreign_export("C",
- dir.make_mkdir_res_exists(in, in, out, di, uo),
- "ML_make_mkdir_res_exists").
-:- pragma foreign_export("C#",
- dir.make_mkdir_res_exists(in, in, out, di, uo),
- "ML_make_mkdir_res_exists").
-:- pragma foreign_export("Java",
- dir.make_mkdir_res_exists(in, in, out, di, uo),
- "ML_make_mkdir_res_exists").
-:- pragma foreign_export("Erlang",
- dir.make_mkdir_res_exists(in, in, out, di, uo),
- "ML_make_mkdir_res_exists").
-
-make_mkdir_res_exists(Error, DirName, Res, !IO) :-
- io.file_type(yes, DirName, TypeResult, !IO),
- ( if TypeResult = ok(directory) then
- dir.check_dir_accessibility(DirName, Res, !IO)
- else
- dir.make_mkdir_res_error(Error, Res, !IO)
- ).
-
-:- pred dir.check_dir_accessibility(string::in, io.res::out, io::di, io::uo)
- is det.
-:- pragma foreign_export("C", dir.check_dir_accessibility(in, out, di, uo),
- "ML_check_dir_accessibility").
-:- pragma foreign_export("C#", dir.check_dir_accessibility(in, out, di, uo),
- "ML_check_dir_accessibility").
-:- pragma foreign_export("Java", dir.check_dir_accessibility(in, out, di, uo),
- "ML_check_dir_accessibility").
-:- pragma foreign_export("Erlang", dir.check_dir_accessibility(in, out, di, uo),
- "ML_check_dir_accessibility").
-
-check_dir_accessibility(DirName, Res, !IO) :-
- % Check whether we can read and write the directory.
- io.check_file_accessibility(DirName, [read, write, execute], Res, !IO).
-
%---------------------------------------------------------------------------%
foldl2(P, DirName, T, Res, !IO) :-
@@ -1609,8 +1610,9 @@ can_implement_dir_foldl :-
SUCCESS_INDICATOR = true
").
- % Win32 doesn't allow us to open a directory without
- % returning the first item.
+ % Win32 doesn't allow us to open a directory without returning the first
+ % item. That ought to be abstracted away by dir.stream as it complicates
+ % all other platforms.
%
:- pred dir.open(string::in, io.result({dir.stream, string})::out,
io::di, io::uo) is det.
@@ -1815,10 +1817,6 @@ make_win32_dir_open_result_ok(Dir, FirstFile0, Result, !IO) :-
:- func make_dir_open_result_eof = io.result({dir.stream, string}).
:- pragma foreign_export("C", (make_dir_open_result_eof = out),
"ML_make_dir_open_result_eof").
-:- pragma foreign_export("C#", (make_dir_open_result_eof = out),
- "ML_make_dir_open_result_eof").
-:- pragma foreign_export("Java", (make_dir_open_result_eof = out),
- "ML_make_dir_open_result_eof").
make_dir_open_result_eof = eof.
@@ -1834,82 +1832,87 @@ make_dir_open_result_eof = eof.
"ML_make_dir_open_result_error").
make_dir_open_result_error(Error, error(io.make_io_error(Msg)), !IO) :-
- io.make_err_msg(Error, "dir.foldl2: opening directory failed: ", Msg, !IO).
+ io.make_err_msg(Error, "dir.foldl2: opening directory failed: ", Msg).
:- pred dir.close(dir.stream::in, io.res::out, io::di, io::uo) is det.
close(Dir, Res, !IO) :-
- dir.close_2(Dir, Status, Error, !IO),
- ( if Status = 0 then
- io.make_maybe_win32_err_msg(Error,
- "dir.foldl2: closing directory failed: ", Msg, !IO),
- Res = error(io.make_io_error(Msg))
+ dir.close_2(Dir, MaybeWin32Error, !IO),
+ ( if
+ is_maybe_win32_error(MaybeWin32Error,
+ "dir.foldl2: closing directory failed: ", IOError)
+ then
+ Res = error(IOError)
else
Res = ok
).
-:- pred dir.close_2(dir.stream::in, int::out, io.system_error::out,
- io::di, io::uo) is det.
+:- pred dir.close_2(dir.stream::in, io.system_error::out, io::di, io::uo)
+ is det.
:- pragma foreign_proc("C",
- dir.close_2(Dir::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ dir.close_2(Dir::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness],
"
#if defined(MR_WIN32)
- Status = FindClose(Dir);
+ if (FindClose(Dir)) {
+ Error = 0;
+ } else {
Error = GetLastError();
+ }
#elif defined(MR_HAVE_CLOSEDIR)
- Status = (closedir(Dir) == 0);
+ if (closedir(Dir) == 0) {
+ Error = 0;
+ } else {
Error = errno;
+ }
#else
- MR_fatal_error(""dir.open called but not supported"");
+ Error = ENOSYS;
#endif
").
:- pragma foreign_proc("C#",
- dir.close_2(_Dir::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ dir.close_2(_Dir::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
-"{
+"
/* Nothing to do. */
Error = null;
- Status = 1;
-}").
+").
:- pragma foreign_proc("Java",
- dir.close_2(_Dir::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ dir.close_2(_Dir::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
-"{
+"
/* Nothing to do. */
Error = null;
- Status = 1;
-}").
+").
:- pragma foreign_proc("Erlang",
- dir.close_2(_Dir::in, Status::out, Error::out, _IO0::di, _IO::uo),
+ dir.close_2(_Dir::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
% Nothing to do.
- Error = null,
- Status = 1
+ Error = ok
").
:- pred dir.read_entry(dir.stream::in, io.result({dir.stream, string})::out,
io::di, io::uo) is det.
read_entry(Dir0, Res, !IO) :-
- dir.read_entry_2(Dir0, Dir, Status, Error, FileName, !IO),
+ dir.read_entry_2(Dir0, Dir, MaybeWin32Error, HaveFileName, FileName, !IO),
( if
- Status = 0
- then
- io.make_maybe_win32_err_msg(Error,
- "dir.foldl2: reading directory entry failed: ", Msg, !IO),
- Res = error(io.make_io_error(Msg))
- else if
- Status = -1
+ is_maybe_win32_error(MaybeWin32Error,
+ "dir.foldl2: reading directory entry failed: ", IOError)
then
+ Res = error(IOError)
+ else
+ (
+ HaveFileName = no,
Res = eof
- else if
+ ;
+ HaveFileName = yes,
+ ( if
( FileName = dir.this_directory
; FileName = dir.parent_directory
)
@@ -1917,16 +1920,19 @@ read_entry(Dir0, Res, !IO) :-
dir.read_entry(Dir0, Res, !IO)
else
Res = ok({Dir, FileName})
+ )
+ )
).
- % dir.read_entry_2(!Dir, Status, Error, FileName, !IO).
- % Status is -1 for EOF, 0 for error, 1 for success.
+ % read_entry_2(Dir0, Dir, MaybeWin32Error, HaveFileName, FileName, !IO):
+ % If there is no error and HaveFileName = no, then we have reached the
+ % end-of-stream.
%
-:- pred dir.read_entry_2(dir.stream::in, dir.stream::out, int::out,
- io.system_error::out, string::out, io::di, io::uo) is det.
+:- pred read_entry_2(dir.stream::in, dir.stream::out, io.system_error::out,
+ bool::out, string::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
- dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out,
+ dir.read_entry_2(Dir0::in, Dir::out, Error::out, HaveFileName::out,
FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
will_not_modify_trail, does_not_affect_liveness],
@@ -1936,38 +1942,44 @@ read_entry(Dir0, Res, !IO) :-
Dir = Dir0;
if (FindNextFileW(Dir, &file_data)) {
- Status = 1;
+ Error = 0;
+ HaveFileName = MR_YES;
FileName = ML_wide_to_utf8(file_data.cFileName, MR_ALLOC_ID);
} else {
Error = GetLastError();
- Status = (Error == ERROR_NO_MORE_FILES ? -1 : 0);
- FileName = NULL;
+ if (Error == ERROR_NO_MORE_FILES) {
+ Error = 0;
+ }
+ HaveFileName = MR_NO;
+ FileName = MR_make_string_const("""");
}
#elif defined(MR_HAVE_READDIR) && defined(MR_HAVE_CLOSEDIR)
struct dirent *dir_entry;
Dir = Dir0;
- errno = 0;
+ errno = 0; /* to detect end-of-stream */
dir_entry = readdir(Dir);
if (dir_entry == NULL) {
- Error = errno;
- FileName = NULL;
- Status = (Error == 0 ? -1 : 0);
+ Error = errno; /* remains zero at end-of-stream */
+ HaveFileName = MR_NO;
+ FileName = MR_make_string_const("""");
} else {
+ Error = 0;
+ HaveFileName = MR_YES;
MR_make_aligned_string_copy_msg(FileName, dir_entry->d_name,
MR_ALLOC_ID);
- Error = 0;
- Status = 1;
}
#else /* !MR_WIN32 && !(MR_HAVE_READDIR etc.) */
- MR_fatal_error(""dir.read_entry_2 called but not supported"");
+ Error = ENOSYS;
+ HaveFileName = MR_NO;
+ FileName = MR_make_string_const("""");
#endif
").
:- pragma foreign_proc("C#",
- dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out,
+ dir.read_entry_2(Dir0::in, Dir::out, Error::out, HaveFileName::out,
FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"{
@@ -1976,51 +1988,57 @@ read_entry(Dir0, Res, !IO) :-
if (Dir.MoveNext()) {
// The .NET CLI returns path names qualified with
// the directory name passed to dir.open.
+ HaveFileName = mr_bool.YES;
FileName = System.IO.Path.GetFileName((string) Dir.Current);
- Status = 1;
} else {
- FileName = null;
- Status = -1;
+ HaveFileName = mr_bool.NO;
+ FileName = """";
}
Error = null;
} catch (System.Exception e) {
Error = e;
- FileName = null;
- Status = 0;
+ HaveFileName = mr_bool.NO;
+ FileName = """";
}
}").
:- pragma foreign_proc("Java",
- dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out,
+ dir.read_entry_2(Dir0::in, Dir::out, Error::out, HaveFileName::out,
FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
Dir = Dir0;
+ try {
if (Dir.hasNext()) {
+ HaveFileName = bool.YES;
FileName = (java.lang.String) Dir.next();
- Status = 1;
} else {
- FileName = null;
- Status = -1;
+ HaveFileName = bool.NO;
+ FileName = """";
}
Error = null;
+ } catch (java.lang.Exception e) {
+ Error = e;
+ HaveFileName = bool.NO;
+ FileName = """";
+ }
").
:- pragma foreign_proc("Erlang",
- dir.read_entry_2(Dir0::in, Dir::out, Status::out, Error::out,
+ dir.read_entry_2(Dir0::in, Dir::out, Error::out, HaveFileName::out,
FileName::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
case Dir0 of
[] ->
- FileName = null,
- Status = -1,
+ HaveFileName = {no},
+ FileName = <<>>,
Dir = [];
[FileNameStr | Dir] ->
- FileName = list_to_binary(FileNameStr),
- Status = 1
+ HaveFileName = {yes},
+ FileName = list_to_binary(FileNameStr)
end,
- Error = null
+ Error = ok
").
%---------------------------------------------------------------------------%
diff --git a/library/io.m b/library/io.m
index 8757678..516f599 100644
--- a/library/io.m
+++ b/library/io.m
@@ -1667,6 +1667,7 @@
% A system-dependent error indication.
% For C, this is 0 for success or the value of errno.
+ % (In a few cases, we pass a Win32 error as a system_error.)
% For Java, this is null for success or an exception object.
% For C#, this is null for success or an exception object.
% For Erlang, this is `ok' for success or `{error, Reason}'.
@@ -1685,34 +1686,28 @@
%
:- pred is_error(system_error::in, string::in, io.error::out) is semidet.
+ % is_maybe_win32_error(Error, MessagePrefix, IOError):
+ % Same as is_error except that `Error' is a Win32 error value on Windows.
+ %
+:- pred is_maybe_win32_error(system_error::in, string::in, io.error::out)
+ is semidet.
+
% make_err_msg(Error, MessagePrefix, Message):
% `Message' is an error message obtained by looking up the
% message for the given errno value and prepending
% `MessagePrefix'.
%
-:- pred make_err_msg(system_error::in, string::in, string::out,
- io::di, io::uo) is det.
-
- % make_win32_err_msg(Error, MessagePrefix, Message):
- %
- % `Message' is an error message obtained by looking up the
- % error message for the given Win32 error number and prepending
- % `MessagePrefix'.
- % This will abort if called on a system which does not support
- % the Win32 API.
- %
-:- pred make_win32_err_msg(system_error::in,
- string::in, string::out, io::di, io::uo) is det.
+:- pred make_err_msg(system_error::in, string::in, string::out) is det.
% make_maybe_win32_err_msg(Error, MessagePrefix, Message):
%
- % `Message' is an error message obtained by looking up the
- % last Win32 error message and prepending `MessagePrefix'.
- % On non-Win32 systems, the message corresponding to the
- % current value of errno will be used.
+ % `Message' is an error message obtained by looking up the error message
+ % for `Error' and prepending `MessagePrefix'.
+ % On Win32 systems, `Error' is obtained by calling GetLastError.
+ % On other systems `Error' is obtained by reading errno.
%
-:- pred make_maybe_win32_err_msg(system_error::in,
- string::in, string::out, io::di, io::uo) is det.
+:- pred make_maybe_win32_err_msg(system_error::in, string::in, string::out)
+ is det.
% Return a unique identifier for the given file (after following
% symlinks in FileName).
@@ -2161,7 +2156,7 @@ read_char(Stream, Result, !IO) :-
Result = eof
;
Result0 = error,
- make_err_msg(Error, "read failed: ", Msg, !IO),
+ make_err_msg(Error, "read failed: ", Msg),
Result = error(io_error(Msg))
).
@@ -2177,7 +2172,7 @@ read_char_unboxed(Stream, Result, Char, !IO) :-
Result = eof
;
Result0 = error,
- make_err_msg(Error, "read failed: ", Msg, !IO),
+ make_err_msg(Error, "read failed: ", Msg),
Result = error(io_error(Msg))
).
@@ -2199,7 +2194,7 @@ read_byte(binary_input_stream(Stream), Result, !IO) :-
Result = eof
;
Result0 = error,
- make_err_msg(Error, "read failed: ", Msg, !IO),
+ make_err_msg(Error, "read failed: ", Msg),
Result = error(io_error(Msg))
).
@@ -2469,7 +2464,7 @@ read_line(Stream, Result, !IO) :-
Result = eof
;
Result0 = error,
- make_err_msg(Error, "read failed: ", Msg, !IO),
+ make_err_msg(Error, "read failed: ", Msg),
Result = error(io_error(Msg))
).
@@ -2514,7 +2509,7 @@ read_line_as_string(input_stream(Stream), Result, !IO) :-
Result = error(io_error("null character in input"))
;
Res = error,
- make_err_msg(Error, "read failed: ", Msg, !IO),
+ make_err_msg(Error, "read failed: ", Msg),
Result = error(io_error(Msg))
).
@@ -3636,38 +3631,6 @@ check_directory_accessibility_dotnet(_, _, _, Error, !IO) :-
}
").
- % XXX only for dir.m
-:- func make_io_res_1_ok_string(string) = io.res(string).
-:- pragma foreign_export("C", (make_io_res_1_ok_string(in) = out),
- "ML_make_io_res_1_ok_string").
-:- pragma foreign_export("C#", (make_io_res_1_ok_string(in) = out),
- "ML_make_io_res_1_ok_string").
-:- pragma foreign_export("Java", (make_io_res_1_ok_string(in) = out),
- "ML_make_io_res_1_ok_string").
-:- pragma foreign_export("Erlang", (make_io_res_1_ok_string(in) = out),
- "ML_make_io_res_1_ok_string").
-
-make_io_res_1_ok_string(String) = ok(String).
-
- % XXX only for dir.m
-:- pred make_io_res_1_error_string(io.system_error::in,
- string::in, io.res(string)::out, io::di, io::uo) is det.
-:- pragma foreign_export("C",
- make_io_res_1_error_string(in, in, out, di, uo),
- "ML_make_io_res_1_error_string").
-:- pragma foreign_export("C#",
- make_io_res_1_error_string(in, in, out, di, uo),
- "ML_make_io_res_1_error_string").
-:- pragma foreign_export("Java",
- make_io_res_1_error_string(in, in, out, di, uo),
- "ML_make_io_res_1_error_string").
-:- pragma foreign_export("Erlang",
- make_io_res_1_error_string(in, in, out, di, uo),
- "ML_make_io_res_1_error_string").
-
-make_io_res_1_error_string(Error, Msg0, error(make_io_error(Msg)), !IO) :-
- io.make_err_msg(Error, Msg0, Msg, !IO).
-
%---------------------------------------------------------------------------%
:- type file_id ---> file_id.
@@ -3804,8 +3767,7 @@ file_id(FileName, Result, !IO) :-
Msg = MR_string_const("""", 0);
Status = 1;
} else {
- ML_maybe_make_err_msg(MR_TRUE, errno, ""stat() failed: "",
- MR_ALLOC_ID, Msg);
+ ML_make_err_msg(errno, ""stat() failed: "", MR_ALLOC_ID, Msg);
Status = 0;
}
#else
@@ -7301,9 +7263,8 @@ have_dotnet :-
#include <errno.h>
/*
-** ML_maybe_make_err_msg(was_error, errnum, msg, alloc_id, error_msg):
-** if `was_error' is true, then append `msg' and a message for errnum
-** to give `error_msg'; otherwise, set `error_msg' to "".
+** ML_make_err_msg(errnum, msg, alloc_id, error_msg):
+** Append `msg' and a message for errnum to give `error_msg'.
**
** WARNING: this must only be called when the `hp' register is valid.
** That means it must only be called from procedures declared
@@ -7314,37 +7275,23 @@ have_dotnet :-
** invalidated by the function call.
*/
-#define ML_maybe_make_err_msg(was_error, errnum, msg, alloc_id, error_msg) \\
+#define ML_make_err_msg(errnum, msg, alloc_id, error_msg) \\
do { \\
char errbuf[MR_STRERROR_BUF_SIZE]; \\
const char *errno_msg; \\
size_t total_len; \\
- MR_Word tmp; \\
\\
- if (was_error) { \\
errno_msg = MR_strerror(errnum, errbuf, sizeof(errbuf)); \\
total_len = strlen(msg) + strlen(errno_msg); \\
- MR_offset_incr_hp_atomic_msg(tmp, 0, \\
- (total_len + sizeof(MR_Word)) / sizeof(MR_Word), \\
- (alloc_id), ""string.string/0""); \\
- (error_msg) = (char *) tmp; \\
+ MR_allocate_aligned_string_msg((error_msg), total_len, (alloc_id)); \\
strcpy((error_msg), msg); \\
strcat((error_msg), errno_msg); \\
- } else { \\
- /* \\
- ** We can't just return NULL here, because otherwise mdb \\
- ** will break when it tries to print the string. \\
- */ \\
- (error_msg) = MR_make_string_const(""""); \\
- } \\
} while(0)
/*
-** ML_maybe_make_win32_err_msg(was_error, error, msg, alloc_id, error_msg):
-** if `was_error' is true, then append `msg' and the string
-** returned by the Win32 API function FormatMessage() for the
-** last error to give `error_msg'; otherwise, set `error_msg' to "".
-** Aborts if MR_WIN32 is not defined.
+** ML_make_win32_err_msg(error, msg, alloc_id, error_msg):
+** Append `msg' and the string returned by the Win32 API function
+** FormatMessage() for the last error to give `error_msg'.
**
** WARNING: this must only be called when the `hp' register is valid.
** That means it must only be called from procedures declared
@@ -7356,15 +7303,12 @@ have_dotnet :-
*/
#ifdef MR_WIN32
-#define ML_maybe_make_win32_err_msg(was_error, error, msg, alloc_id, \\
- error_msg) \\
+#define ML_make_win32_err_msg(error, msg, alloc_id, error_msg) \\
do { \\
size_t total_len; \\
- MR_Word tmp; \\
- \\
- if (was_error) { \\
LPVOID err_buf; \\
MR_bool free_err_buf = MR_TRUE; \\
+ \\
if (!FormatMessage( \\
FORMAT_MESSAGE_ALLOCATE_BUFFER \\
| FORMAT_MESSAGE_FROM_SYSTEM \\
@@ -7380,33 +7324,15 @@ have_dotnet :-
err_buf = (LPVOID) ""could not retrieve error message""; \\
} \\
total_len = strlen(msg) + strlen((char *)err_buf); \\
- MR_incr_hp_atomic_msg(tmp, \\
- (total_len + sizeof(MR_Word)) / sizeof(MR_Word), \\
- (alloc_id), ""string.string/0""); \\
- (error_msg) = (char *) tmp; \\
+ MR_allocate_aligned_string_msg((error_msg), total_len, (alloc_id)); \\
strcpy((error_msg), msg); \\
strcat((error_msg), (char *)err_buf); \\
if (free_err_buf) { \\
LocalFree(err_buf); \\
} \\
- } else { \\
- /* \\
- ** We can't just return NULL here, because otherwise mdb \\
- ** will break when it tries to print the string. \\
- */ \\
- (error_msg) = MR_make_string_const(""""); \\
- } \\
} while(0)
-#else /* !MR_WIN32 */
-
-#define ML_maybe_make_win32_err_msg(was_error, error, msg, alloc_id, \\
- error_msg) \\
- MR_fatal_error( \\
- ""ML_maybe_make_win32_err_msg called on non-Windows platform"")
-
#endif /* !MR_WIN32 */
-
").
:- func no_error = system_error.
@@ -7439,84 +7365,69 @@ have_dotnet :-
Error = ok
").
+:- pred is_success(system_error::in) is semidet.
+
+:- 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 foreign_proc("Erlang",
+ is_success(Error::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = (Error =:= ok)
+").
+
is_error(Error, Prefix, io_error(Message)) :-
- is_error_2(Error, Prefix, Message).
+ ( if is_success(Error) then
+ fail
+ else
+ make_err_msg(Error, Prefix, Message)
+ ).
-:- pred is_error_2(system_error::in, string::in, string::out) is semidet.
+is_maybe_win32_error(Error, Prefix, io_error(Message)) :-
+ ( if is_success(Error) then
+ fail
+ else
+ make_maybe_win32_err_msg(Error, Prefix, Message)
+ ).
:- pragma foreign_proc("C",
- is_error_2(Error::in, Prefix::in, Message::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- if (Error != 0) {
- SUCCESS_INDICATOR = MR_TRUE;
- ML_maybe_make_err_msg(MR_TRUE, Error, Prefix, MR_ALLOC_ID, Message);
- } else {
- SUCCESS_INDICATOR = MR_FALSE;
- Message = MR_make_string_const("""");
- }
-").
-
-:- pragma foreign_proc("C#",
- is_error_2(Error::in, Prefix::in, Message::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- if (Error != null) {
- SUCCESS_INDICATOR = true;
- Message = Prefix + Error.Message;
- } else {
- SUCCESS_INDICATOR = false;
- Message = """";
- }
-").
-
-:- pragma foreign_proc("Java",
- is_error_2(Error::in, Prefix::in, Message::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- if (Error != null) {
- SUCCESS_INDICATOR = true;
- Message = Prefix + Error.getMessage(); // null is okay
- } else {
- SUCCESS_INDICATOR = false;
- Message = """";
- }
-").
-
-:- pragma foreign_proc("Erlang",
- is_error_2(Error::in, Prefix::in, Message::out),
- [will_not_call_mercury, promise_pure, thread_safe],
-"
- case Error of
- ok ->
- SUCCESS_INDICATOR = false,
- Message = <<>>;
- {error, Reason} ->
- SUCCESS_INDICATOR = true,
- Message = list_to_binary([Prefix, file:format_error(Reason)])
- end
-").
-
- % XXX these should require the io.state any more
- %
-:- pragma foreign_proc("C",
- make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+ make_err_msg(Error::in, Msg0::in, Msg::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
does_not_affect_liveness, no_sharing],
"
- ML_maybe_make_err_msg(MR_TRUE, Error, Msg0, MR_ALLOC_ID, Msg);
+ ML_make_err_msg(Error, Msg0, MR_ALLOC_ID, Msg);
").
:- pragma foreign_proc("C#",
- make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure],
+ make_err_msg(Error::in, Msg0::in, Msg::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"{
Msg = System.String.Concat(Msg0, Error.Message);
}").
:- pragma foreign_proc("Java",
- make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure],
+ make_err_msg(Error::in, Msg0::in, Msg::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
if (Error.getMessage() != null) {
Msg = Msg0 + Error.getMessage();
@@ -7526,8 +7437,8 @@ is_error(Error, Prefix, io_error(Message)) :-
").
:- pragma foreign_proc("Erlang",
- make_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure],
+ make_err_msg(Error::in, Msg0::in, Msg::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
"
case Error of
{error, Reason} ->
@@ -7537,28 +7448,36 @@ is_error(Error, Prefix, io_error(Message)) :-
end
").
-make_win32_err_msg(_, _, "", !IO) :-
- ( if semidet_succeed then
- error("io.make_win32_err_msg called for non Win32 back-end")
- else
- true
- ).
-
-:- pragma foreign_proc("C",
- make_win32_err_msg(Error::in, Msg0::in, Msg::out, _IO0::di, _IO::uo),
- [will_not_call_mercury, promise_pure, tabled_for_io,
- does_not_affect_liveness, no_sharing],
-"
- ML_maybe_make_win32_err_msg(MR_TRUE, Error, Msg0, MR_ALLOC_ID, Msg);
-").
-
-make_maybe_win32_err_msg(Error, Msg0, Msg, !IO) :-
+make_maybe_win32_err_msg(Error, Msg0, Msg) :-
( if have_win32 then
- make_win32_err_msg(Error, Msg0, Msg, !IO)
+ make_win32_err_msg(Error, Msg0, Msg)
else
- make_err_msg(Error, Msg0, Msg, !IO)
+ make_err_msg(Error, Msg0, Msg)
).
+:- pred make_win32_err_msg(system_error::in, string::in, string::out) is det.
+
+make_win32_err_msg(_, _, "") :-
+ ( if semidet_succeed then
+ error("io.make_win32_err_msg called for non Win32 back-end")
+ else
+ true
+ ).
+
+ % Is FormatMessage thread-safe?
+ %
+:- pragma foreign_proc("C",
+ make_win32_err_msg(Error::in, Msg0::in, Msg::out),
+ [will_not_call_mercury, promise_pure, does_not_affect_liveness,
+ no_sharing],
+"
+#ifdef MR_WIN32
+ ML_make_win32_err_msg(Error, Msg0, MR_ALLOC_ID, Msg);
+#else
+ MR_fatal_error(""io.make_win32_err_msg called on non-Windows platform"");
+#endif
+").
+
:- pred throw_on_error(system_error::in, string::in, io::di, io::uo) is det.
throw_on_error(Error, Prefix, !IO) :-
@@ -9900,8 +9819,7 @@ close_binary_output(binary_output_stream(Stream), !IO) :-
if (err != 0) {
/* Spawn failed. */
Success = MR_NO;
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error invoking system command: "",
+ ML_make_err_msg(errno, ""error invoking system command: "",
MR_ALLOC_ID, Msg);
} else {
/* Wait for the spawned process to exit. */
@@ -9910,8 +9828,7 @@ close_binary_output(binary_output_stream(Stream), !IO) :-
} while (err == -1 && MR_is_eintr(errno));
if (err == -1) {
Success = MR_NO;
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error invoking system command: "",
+ ML_make_err_msg(errno, ""error invoking system command: "",
MR_ALLOC_ID, Msg);
} else {
Status = st;
@@ -9929,8 +9846,7 @@ close_binary_output(binary_output_stream(Stream), !IO) :-
if (Status == -1) {
Success = MR_NO;
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error invoking system command: "",
+ ML_make_err_msg(errno, ""error invoking system command: "",
MR_ALLOC_ID, Msg);
} else {
Success = MR_YES;
@@ -10526,18 +10442,21 @@ import java.util.Random;
Dir, Sep, Prefix, Suffix);
fd = mkstemp(FileName);
if (fd == -1) {
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error opening temporary file: "", MR_ALLOC_ID,
+ ML_make_err_msg(errno, ""error opening temporary file: "", MR_ALLOC_ID,
ErrorMessage);
Okay = MR_NO;
} else {
do {
err = close(fd);
} while (err == -1 && MR_is_eintr(errno));
- ML_maybe_make_err_msg(err, errno,
- ""error closing temporary file: "", MR_ALLOC_ID,
- ErrorMessage);
- Okay = err == 0 ? MR_YES : MR_NO;
+ if (err == 0) {
+ ErrorMessage = MR_make_string_const("""");
+ Okay = MR_YES;
+ } else {
+ ML_make_err_msg(errno, ""error closing temporary file: "",
+ MR_ALLOC_ID, ErrorMessage);
+ Okay = MR_NO;
+ }
}
#else
/*
@@ -10582,18 +10501,21 @@ import java.util.Random;
} while (fd == -1 && errno == EEXIST &&
num_tries < ML_MAX_TEMPNAME_TRIES);
if (fd == -1) {
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error opening temporary file: "", MR_ALLOC_ID,
+ ML_make_err_msg(errno, ""error opening temporary file: "", MR_ALLOC_ID,
ErrorMessage);
Okay = MR_NO;
} else {
do {
err = close(fd);
} while (err == -1 && MR_is_eintr(errno));
- ML_maybe_make_err_msg(err, errno,
- ""error closing temporary file: "", MR_ALLOC_ID,
- ErrorMessage);
- Okay = err == 0 ? MR_YES : MR_NO;
+ if (err == 0) {
+ ErrorMessage = MR_make_string_const("""");
+ Okay = MR_YES;
+ } else {
+ ML_make_err_msg(errno, ""error closing temporary file: "",
+ MR_ALLOC_ID, ErrorMessage);
+ Okay = MR_NO;
+ }
}
#endif
").
@@ -10740,9 +10662,8 @@ import java.util.Random;
Dir, Sep, Prefix, Suffix);
DirName = mkdtemp(DirName);
if (DirName == NULL) {
- ML_maybe_make_err_msg(MR_TRUE, errno,
- ""error creating temporary directory: "", MR_ALLOC_ID,
- ErrorMessage);
+ ML_make_err_msg(errno, ""error creating temporary directory: "",
+ MR_ALLOC_ID, ErrorMessage);
Okay = MR_NO;
} else {
ErrorMessage = MR_make_string_const("""");
diff --git a/mdbcomp/program_representation.m b/mdbcomp/program_representation.m
index 2579c4a9..5decf0a 100644
--- a/mdbcomp/program_representation.m
+++ b/mdbcomp/program_representation.m
@@ -984,7 +984,7 @@ maybe_search_var_name(VarNameTable, VarRep, MaybeString) :-
read_file_as_bytecode(FileName, Result, !IO) :-
read_file_as_bytecode_2(FileName, ByteCode, Size, Error, !IO),
( if Size < 0 then
- io.make_err_msg(Error, "opening " ++ FileName ++ ": ", Msg, !IO),
+ io.make_err_msg(Error, "opening " ++ FileName ++ ": ", Msg),
Result = error(io.make_io_error(Msg))
else
Result = ok(bytecode(ByteCode, Size))
More information about the reviews
mailing list