[m-rev.] for review: Reduce use of foreign-exported procs in io.m.

Peter Wang novalazy at gmail.com
Mon Oct 3 14:45:43 AEDT 2016


library/io.m:
    Use foreign-exported enum for `file_type', replacing many
    foreign-exported procs.

    Move construction/deconstruction of Mercury structures out of
    `file_modification_time_2', `file_type_2', `check_file_accessibility_2',
    `check_directory_accessibility_dotnet', etc., removing the need for many
    foreign-exported procs.

    Delete `file_type_implemented'. `file_type_2' will return an error
    code if necessary.
---
 library/io.m | 828 ++++++++++++++++++++++-------------------------------------
 1 file changed, 300 insertions(+), 528 deletions(-)

diff --git a/library/io.m b/library/io.m
index 933c36a..8bfa9d5 100644
--- a/library/io.m
+++ b/library/io.m
@@ -3032,20 +3032,22 @@ binary_input_stream_file_size(binary_input_stream(Stream), Size, !IO) :-
     Size = mercury__io:mercury_get_file_size(Stream)
 ").
 
+%---------------------------------------------------------------------------%
+
 file_modification_time(File, Result, !IO) :-
-    file_modification_time_2(File, Status, Msg, Time, !IO),
-    ( if Status = 1 then
-        Result = ok(Time)
+    file_modification_time_2(File, Time, Error, !IO),
+    ( if is_error(Error, "can't get file modification time: ", Message) then
+        Result = error(io_error(Message))
     else
-        Result = error(io_error(Msg))
+        Result = ok(Time)
     ).
 
-:- pred io.file_modification_time_2(string::in, int::out, string::out,
-    time_t::out, io::di, io::uo) is det.
+:- pred file_modification_time_2(string::in, time_t::out, system_error::out,
+    io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    file_modification_time_2(FileName::in, Status::out, Msg::out,
-        Time::out, _IO0::di, _IO::uo),
+    file_modification_time_2(FileName::in, Time::out, Error::out,
+        _IO0::di, _IO::uo),
     [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
         does_not_affect_liveness, no_sharing],
 "
@@ -3059,146 +3061,109 @@ file_modification_time(File, Result, !IO) :-
   #endif
 
     if (stat_result == 0) {
+        /* XXX avoid ML_construct_time_t by returning time_t_rep? */
         Time = ML_construct_time_t(s.st_mtime);
-        Msg = MR_string_const("""", 0);
-        Status = 1;
+        Error = 0;
     } else {
-        ML_maybe_make_err_msg(MR_TRUE, errno, ""stat() failed: "",
-            MR_ALLOC_ID, Msg);
-        Status = 0;
-        Time = 0;   /* Dummy value -- will not be used. */
+        Error = errno;
+        Time = 0;
     }
 #else
-    Status = 0;
-    Msg = MR_make_string_const(
-        ""io.file_modification_time not available on this platform"");
+    Error = ENOSYS;
+    Time = 0;
 #endif
 ").
 
 :- pragma foreign_proc("C#",
-    file_modification_time_2(FileName::in, Status::out, Msg::out,
-        Time::out, _IO0::di, _IO::uo),
-    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
-"{
+    file_modification_time_2(FileName::in, Time::out, Error::out,
+        _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
     try {
         if (System.IO.File.Exists(FileName)) {
             System.DateTime t = System.IO.File.GetLastWriteTime(FileName);
             Time = time.ML_construct_time_t(t);
-            Msg = """";
-            Status = 1;
+            Error = null;
         } else {
-            Msg = ""File not found"";
+            Error = new System.IO.FileNotFoundException();
             Time = null;
-            Status = 0;
         }
-
     } catch (System.Exception e) {
-        Msg = ""GetLastWriteTime() failed: "" + e.Message;
+        Error = e;
         Time = null;
-        Status = 0;
     }
-}").
+").
 
 :- pragma foreign_proc("Java",
-    file_modification_time_2(FileName::in, Status::out, Msg::out,
-        Time::out, _IO0::di, _IO::uo),
-    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+    file_modification_time_2(FileName::in, Time::out, Error::out,
+        _IO0::di, _IO::uo),
+    [may_call_mercury, promise_pure, tabled_for_io, thread_safe,
         may_not_duplicate],
 "
-    java.util.Date date = new java.util.Date();
     try {
-        long time = (new java.io.File(FileName)).lastModified();
-        if (time == 0) {
-            throw new java.lang.Exception(""File not found or I/O error"");
+        long modtime = (new java.io.File(FileName)).lastModified();
+        if (modtime == 0) {
+            Error = new java.io.FileNotFoundException(
+                ""File not found or I/O error"");
+            Time = null;
+        } else {
+            Time = time.ML_construct_time_t(new java.util.Date(modtime));
+            Error = null;
         }
-        date.setTime(time);
-        Msg = """";
-        Status = 1;
     } catch (java.lang.Exception e) {
-        Msg = ""lastModified() failed: "" + e.getMessage();
-        Status = 0;
+        Error = e;
+        Time = null;
     }
-    Time = time.ML_construct_time_t(date);
 ").
 
 :- pragma foreign_proc("Erlang",
-    file_modification_time_2(FileName::in, Status::out, Msg::out,
-        Time::out, _IO0::di, _IO::uo),
+    file_modification_time_2(FileName::in, Time::out, Error::out,
+        _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
     FileNameStr = binary_to_list(FileName),
     case filelib:last_modified(FileNameStr) of
         {YMD, HMS} ->
-            Status = 1,
-            Msg = <<>>,
             % time_t in Erlang is in UTC.
-            Time = {time_t, erlang:localtime_to_universaltime({YMD, HMS})};
-        _ ->
-            Status = 0,
-            Msg = <<""filelib:last_modified failed"">>,
-            Time = -1
+            Time = {time_t, erlang:localtime_to_universaltime({YMD, HMS})},
+            Error = ok;
+        0 ->
+            Error = {error, enoent},
+            Time = {time_t, erlang:localtime()}
     end
 ").
 
 %---------------------------------------------------------------------------%
 
-file_type(FollowSymLinks, FileName, MaybeType, !IO) :-
-    ( if file_type_implemented then
-        (
-            FollowSymLinks = yes,
-            FollowSymLinksInt = 1
-        ;
-            FollowSymLinks = no,
-            FollowSymLinksInt = 0
-        ),
-        io.file_type_2(FollowSymLinksInt, FileName, MaybeType, !IO)
+:- pragma foreign_export_enum("C", file_type/0,
+    [prefix("ML_FILE_TYPE_"), uppercase]).
+:- pragma foreign_export_enum("C#", file_type/0,
+    [prefix("ML_FILE_TYPE_"), uppercase]).
+:- pragma foreign_export_enum("Java", file_type/0,
+    [prefix("ML_FILE_TYPE_"), uppercase]).
+
+file_type(FollowSymLinks, FileName, Result, !IO) :-
+    (
+        FollowSymLinks = yes,
+        FollowSymLinksInt = 1
+    ;
+        FollowSymLinks = no,
+        FollowSymLinksInt = 0
+    ),
+    file_type_2(FollowSymLinksInt, FileName, FileType, Error,  !IO),
+    ( if is_error(Error, "can't find file type: ", Message) then
+        Result = error(io_error(Message))
     else
-        MaybeType = error(io.make_io_error(
-            "Sorry, io.file_type not implemented on this platform"))
+        Result = ok(FileType)
     ).
 
-:- pred file_type_implemented is semidet.
-
-file_type_implemented :-
-    semidet_fail.
-
-:- pragma foreign_proc("C",
-    file_type_implemented,
-    [will_not_call_mercury, promise_pure, thread_safe,
-        does_not_affect_liveness, no_sharing],
-"
-#ifdef MR_HAVE_STAT
-    SUCCESS_INDICATOR = MR_TRUE;
-#else
-    SUCCESS_INDICATOR = MR_FALSE;
-#endif
-").
-:- pragma foreign_proc("C#",
-    file_type_implemented,
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    SUCCESS_INDICATOR = true;
-").
-:- pragma foreign_proc("Java",
-    file_type_implemented,
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    SUCCESS_INDICATOR = true;
-").
-:- pragma foreign_proc("Erlang",
-    file_type_implemented,
-    [will_not_call_mercury, promise_pure, thread_safe],
-"
-    SUCCESS_INDICATOR = true
-").
-
-:- pred file_type_2(int::in, string::in, io.res(io.file_type)::out,
+:- pred file_type_2(int::in, string::in, file_type::out, system_error::out,
     io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    file_type_2(FollowSymLinks::in, FileName::in, Result::out,
+    file_type_2(FollowSymLinks::in, FileName::in, FileType::out, Error::out,
         _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         does_not_affect_liveness, no_sharing],
 "
 #ifdef MR_HAVE_STAT
@@ -3221,119 +3186,122 @@ file_type_implemented :-
   #endif
 
     if (stat_result == 0) {
-        MR_Word type;
-
-        #if defined(S_ISREG)
-            if (S_ISREG(s.st_mode)) {
-                type = ML_file_type_regular();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFREG)
-            if ((s.st_mode & S_IFMT) == S_IFREG) {
-                type = ML_file_type_regular();
-            } else
-        #endif
-
-        #if defined(S_ISDIR)
-            if (S_ISDIR(s.st_mode)) {
-                type = ML_file_type_directory();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFDIR)
-            if ((s.st_mode & S_IFMT) == S_IFDIR) {
-                type = ML_file_type_directory();
-            } else
-        #endif
-
-        #if defined(S_ISBLK)
-            if (S_ISBLK(s.st_mode)) {
-                type = ML_file_type_block_device();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFBLK)
-            if ((s.st_mode & S_IFMT) == S_IFBLK) {
-                type = ML_file_type_block_device();
-            } else
-        #endif
-
-        #if defined(S_ISCHR)
-            if (S_ISCHR(s.st_mode)) {
-                type = ML_file_type_character_device();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFCHR)
-            if ((s.st_mode & S_IFMT) == S_IFCHR) {
-                type = ML_file_type_character_device();
-            } else
-        #endif
-
-        #if defined(S_ISFIFO)
-            if (S_ISFIFO(s.st_mode)) {
-                type = ML_file_type_fifo();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFIFO)
-            if ((s.st_mode & S_IFMT) == S_IFIFO) {
-                type = ML_file_type_fifo();
-            } else
-        #endif
-
-        #if defined(S_ISLNK)
-            if (S_ISLNK(s.st_mode)) {
-                type = ML_file_type_symbolic_link();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFLNK)
-            if ((s.st_mode & S_IFMT) == S_IFLNK) {
-                type = ML_file_type_symbolic_link();
-            } else
-        #endif
-
-        #if defined(S_ISSOCK)
-            if (S_ISSOCK(s.st_mode)) {
-                type = ML_file_type_socket();
-            } else
-        #elif defined(S_IFMT) && defined(S_IFSOCK)
-            if ((s.st_mode & S_IFMT) == S_IFSOCK) {
-                type = ML_file_type_socket();
-            } else
-        #endif
+        /* Do we still need the non-POSIX S_IFMT style? */
+        if
+            #if defined(S_ISREG)
+                (S_ISREG(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFREG)
+                ((s.st_mode & S_IFMT) == S_IFREG)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_REGULAR_FILE;
+        }
+        else if
+            #if defined(S_ISDIR)
+                (S_ISDIR(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFDIR)
+                ((s.st_mode & S_IFMT) == S_IFDIR)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_DIRECTORY;
+        }
+        else if
+            #if defined(S_ISBLK)
+                (S_ISBLK(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFBLK)
+                ((s.st_mode & S_IFMT) == S_IFBLK)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_BLOCK_DEVICE;
+        }
+        else if
+            #if defined(S_ISCHR)
+                (S_ISCHR(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFCHR)
+                ((s.st_mode & S_IFMT) == S_IFCHR)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_CHARACTER_DEVICE;
+        }
+        else if
+            #if defined(S_ISFIFO)
+                (S_ISFIFO(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFIFO)
+                ((s.st_mode & S_IFMT) == S_IFIFO)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_NAMED_PIPE;
+        }
+        else if
+            #if defined(S_ISLNK)
+                (S_ISLNK(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFLNK)
+                ((s.st_mode & S_IFMT) == S_IFLNK)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_SYMBOLIC_LINK;
+        }
+        else if
+            #if defined(S_ISSOCK)
+                (S_ISSOCK(s.st_mode))
+            #elif defined(S_IFMT) && defined(S_IFSOCK)
+                ((s.st_mode & S_IFMT) == S_IFSOCK)
+            #else
+                (0)
+            #endif
+        {
+            FileType = ML_FILE_TYPE_SOCKET;
+        } else {
 
         #ifdef S_TYPEISMQ
             if (S_TYPEISMQ(&s)) {
-                type = ML_file_type_message_queue();
+                FileType = ML_FILE_TYPE_MESSAGE_QUEUE;
             } else
         #endif
 
         #ifdef S_TYPEISSEM
             if (S_TYPEISSEM(&s)) {
-                type = ML_file_type_semaphore();
+                FileType = ML_FILE_TYPE_SEMAPHORE;
             } else
         #endif
 
         #ifdef S_TYPEISSHM
             if (S_TYPEISSHM(&s)) {
-                type = ML_file_type_shared_memory();
+                FileType = ML_FILE_TYPE_SHARED_MEMORY;
             } else
         #endif
 
             {
-                type = ML_file_type_unknown();
+                FileType = ML_FILE_TYPE_UNKNOWN;
             }
-
-        Result = ML_make_io_res_1_ok_file_type(type);
+        }
+        Error = 0;
     } else {
-        /*
-        ** We can't just call ML_make_err_msg here because
-        ** it uses `hp' and this procedure can call Mercury.
-        */
-        ML_make_io_res_1_error_file_type(errno,
-            MR_make_string_const(""io.file_type failed: ""), &Result);
+        FileType = ML_FILE_TYPE_UNKNOWN;
+        Error = errno;
     }
 #else
-    MR_fatal_error(
-        ""Sorry, io.file_type not implemented on this platform"") }
+    FileType = ML_FILE_TYPE_UNKNOWN;
+    Error = ENOSYS;
 #endif
 ").
 
 :- pragma foreign_proc("C#",
-    file_type_2(_FollowSymLinks::in, FileName::in, Result::out,
+    file_type_2(_FollowSymLinks::in, FileName::in, FileType::out, Error::out,
         _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
     try {
         System.IO.FileAttributes attrs =
@@ -3341,49 +3309,51 @@ file_type_implemented :-
         if ((attrs & System.IO.FileAttributes.Directory) ==
             System.IO.FileAttributes.Directory)
         {
-            Result = io.ML_make_io_res_1_ok_file_type(
-                io.ML_file_type_directory());
+            FileType = io.ML_FILE_TYPE_DIRECTORY;
         }
         else if ((attrs & System.IO.FileAttributes.Device) ==
             System.IO.FileAttributes.Device)
         {
             // XXX It may be a block device, but .NET doesn't
             // distinguish between character and block devices.
-            Result = io.ML_make_io_res_1_ok_file_type(
-                io.ML_file_type_character_device());
+            FileType = io.ML_FILE_TYPE_CHARACTER_DEVICE;
         }
         else
         {
-            Result = io.ML_make_io_res_1_ok_file_type(
-                io.ML_file_type_regular());
+            FileType = io.ML_FILE_TYPE_REGULAR_FILE;
         }
+        Error = null;
     } catch (System.Exception e) {
-        Result = io.ML_make_io_res_1_error_file_type(e,
-            ""can't find file type: "");
+        FileType = ML_FILE_TYPE_UNKNOWN;
+        Error = e;
     }
 ").
 
 :- pragma foreign_proc("Java",
-    file_type_2(_FollowSymLinks::in, FileName::in,
-        Result::out, _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    file_type_2(_FollowSymLinks::in, FileName::in, FileType::out, Error::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         may_not_duplicate],
 "
-    java.io.File file = new java.io.File(FileName);
-
     // The Java implementation can distinguish between regular files and
     // directories, and for everything else it just returns unknown.
 
-    if (file.isFile()) {
-        Result = new io.Res_1.Ok_1(ML_file_type_regular());
-    } else if (file.isDirectory()) {
-        Result = new io.Res_1.Ok_1(ML_file_type_directory());
-    } else if (file.exists()) {
-        Result = new io.Res_1.Ok_1(ML_file_type_unknown());
-    } else {
-        Result = io.ML_make_io_res_1_error_file_type(
-            new java.lang.Exception(""No such file or directory""),
-            ""io.file_type failed: "");
+    FileType = io.ML_FILE_TYPE_UNKNOWN;
+    Error = null;
+
+    try {
+        java.io.File file = new java.io.File(FileName);
+        if (file.isFile()) {
+            FileType = io.ML_FILE_TYPE_REGULAR_FILE;
+        } else if (file.isDirectory()) {
+            FileType = io.ML_FILE_TYPE_DIRECTORY;
+        } else if (file.exists()) {
+            FileType = io.ML_FILE_TYPE_UNKNOWN;
+        } else {
+            Error = new java.io.FileNotFoundException();
+        }
+    } catch (java.lang.Exception e) {
+        Error = e;
     }
 ").
 
@@ -3392,9 +3362,9 @@ file_type_implemented :-
 ").
 
 :- pragma foreign_proc("Erlang",
-    file_type_2(FollowSymLinks::in, FileName::in,
-        Result::out, _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    file_type_2(FollowSymLinks::in, FileName::in, FileType::out, Error::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         may_not_duplicate],
 "
     FileNameStr = binary_to_list(FileName),
@@ -3409,137 +3379,73 @@ file_type_implemented :-
                 device ->
                     % XXX It may be a block device, but Erlang doesn't
                     % distinguish between character and block devices.
-                    Result = mercury__io:'ML_make_io_res_1_ok_file_type'(
-                        mercury__io:'ML_file_type_character_device'());
+                    FileType = {character_device};
                 directory ->
-                    Result = mercury__io:'ML_make_io_res_1_ok_file_type'(
-                        mercury__io:'ML_file_type_directory'());
+                    FileType = {directory};
                 regular ->
-                    Result = mercury__io:'ML_make_io_res_1_ok_file_type'(
-                        mercury__io:'ML_file_type_regular'());
+                    FileType = {regular_file};
                 symlink ->
-                    Result = mercury__io:'ML_make_io_res_1_ok_file_type'(
-                        mercury__io:'ML_file_type_symbolic_link'());
+                    FileType = {symbolic_link};
                 other ->
-                    Result = mercury__io:'ML_make_io_res_1_ok_file_type'(
-                        mercury__io:'ML_file_type_unknown'())
-            end;
+                    FileType = {unknown}
+            end,
+            Error = ok;
         {error, Reason} ->
-            Result = mercury__io:'ML_make_io_res_1_error_file_type'(Reason,
-                ""io.file_type failed: "")
+            FileType = {unknown},
+            Error = {error, Reason}
     end
 ").
 
-:- func file_type_character_device = file_type.
-:- func file_type_block_device = file_type.
-:- func file_type_fifo = file_type.
-:- func file_type_directory = file_type.
-:- func file_type_socket = file_type.
-:- func file_type_symbolic_link = file_type.
-:- func file_type_regular = file_type.
-:- func file_type_message_queue = file_type.
-:- func file_type_semaphore = file_type.
-:- func file_type_shared_memory = file_type.
-:- func file_type_unknown = file_type.
-
-file_type_character_device = character_device.
-file_type_block_device = block_device.
-file_type_fifo = named_pipe.
-file_type_directory = directory.
-file_type_socket = socket.
-file_type_symbolic_link = symbolic_link.
-file_type_regular = regular_file.
-file_type_message_queue = message_queue.
-file_type_semaphore = semaphore.
-file_type_shared_memory = shared_memory.
-file_type_unknown = unknown.
-
-    % XXX use pragma foreign_export_enum
-:- pragma foreign_export("C", file_type_character_device = out,
-    "ML_file_type_character_device").
-:- pragma foreign_export("C#", file_type_character_device = out,
-    "ML_file_type_character_device").
-:- pragma foreign_export("Erlang", file_type_character_device = out,
-    "ML_file_type_character_device").
-:- pragma foreign_export("C", file_type_block_device = out,
-    "ML_file_type_block_device").
-:- pragma foreign_export("C#", file_type_block_device = out,
-    "ML_file_type_block_device").
-:- pragma foreign_export("C", file_type_fifo = out,
-    "ML_file_type_fifo").
-:- pragma foreign_export("C#", file_type_fifo = out,
-    "ML_file_type_fifo").
-:- pragma foreign_export("C", file_type_directory = out,
-    "ML_file_type_directory").
-:- pragma foreign_export("C#", file_type_directory = out,
-    "ML_file_type_directory").
-:- pragma foreign_export("Java", file_type_directory = out,
-    "ML_file_type_directory").
-:- pragma foreign_export("Erlang", file_type_directory = out,
-    "ML_file_type_directory").
-:- pragma foreign_export("C", file_type_socket = out,
-    "ML_file_type_socket").
-:- pragma foreign_export("C#", file_type_socket = out,
-    "ML_file_type_socket").
-:- pragma foreign_export("C", file_type_symbolic_link = out,
-    "ML_file_type_symbolic_link").
-:- pragma foreign_export("C#", file_type_symbolic_link = out,
-    "ML_file_type_symbolic_link").
-:- pragma foreign_export("Erlang", file_type_symbolic_link = out,
-    "ML_file_type_symbolic_link").
-:- pragma foreign_export("C", file_type_regular = out,
-    "ML_file_type_regular").
-:- pragma foreign_export("C#", file_type_regular = out,
-    "ML_file_type_regular").
-:- pragma foreign_export("Java", file_type_regular = out,
-    "ML_file_type_regular").
-:- pragma foreign_export("Erlang", file_type_regular = out,
-    "ML_file_type_regular").
-:- pragma foreign_export("C", file_type_message_queue = out,
-    "ML_file_type_message_queue").
-:- pragma foreign_export("C#", file_type_message_queue = out,
-    "ML_file_type_message_queue").
-:- pragma foreign_export("C", file_type_semaphore = out,
-    "ML_file_type_semaphore").
-:- pragma foreign_export("C#", file_type_semaphore = out,
-    "ML_file_type_semaphore").
-:- pragma foreign_export("C", file_type_shared_memory = out,
-    "ML_file_type_shared_memory").
-:- pragma foreign_export("C#", file_type_shared_memory = out,
-    "ML_file_type_shared_memory").
-:- pragma foreign_export("C", file_type_unknown = out,
-    "ML_file_type_unknown").
-:- pragma foreign_export("C#", file_type_unknown = out,
-    "ML_file_type_unknown").
-:- pragma foreign_export("Java", file_type_unknown = out,
-    "ML_file_type_unknown").
-:- pragma foreign_export("Erlang", file_type_unknown = out,
-    "ML_file_type_unknown").
-
 %---------------------------------------------------------------------------%
 
 check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
     ( if have_dotnet then
         check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO)
     else
-        check_file_accessibility_2(FileName, AccessTypes, Result, !IO)
+        CheckRead = pred_to_bool(contains(AccessTypes, read)),
+        CheckWrite = pred_to_bool(contains(AccessTypes, write)),
+        CheckExecute = pred_to_bool(contains(AccessTypes, execute)),
+        check_file_accessibility_2(FileName, CheckRead, CheckWrite,
+            CheckExecute, Error, !IO),
+        ( if is_error(Error, "file not accessible: ", Message) then
+            Result = error(io_error(Message))
+        else
+            Result = ok
+        )
     ).
 
-:- pred check_file_accessibility_2(string::in, list(access_type)::in,
-    io.res::out, io::di, io::uo) is det.
+:- pred check_file_accessibility_2(string::in, bool::in, bool::in, bool::in,
+    system_error::out, io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    check_file_accessibility_2(FileName::in, AccessTypes::in, Result::out,
-        _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    check_file_accessibility_2(FileName::in, CheckRead::in,
+        CheckWrite::in, CheckExecute::in, Error::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         does_not_affect_liveness, no_sharing],
 "
 #if defined(MR_HAVE_ACCESS)
   #ifdef F_OK
-    int mode = F_OK;
+    const int MODE_EXISTS = F_OK;
+  #else
+    const int MODE_EXISTS = 0;
+  #endif
+  #ifdef X_OK
+    const int MODE_EXECUTE = X_OK;
+  #else
+    const int MODE_EXECUTE = 1;
+  #endif
+  #ifdef W_OK
+    const int MODE_WRITE = W_OK;
+  #else
+    const int MODE_WRITE = 2;
+  #endif
+  #ifdef R_OK
+    const int MODE_READ = R_OK;
   #else
-    int mode = 0;
+    const int MODE_READ = 4;
   #endif
+
+    int mode = MODE_EXISTS;
     int access_result;
 
   #if !defined(MR_WIN32) || defined(MR_CYGWIN)
@@ -3547,27 +3453,15 @@ check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
     ** Earlier versions of MSVCRT ignored flags it doesn't support,
     ** later versions return an error (e.g. on Vista).
     */
-    if (ML_access_types_includes_execute(AccessTypes)) {
-      #ifdef X_OK
-        mode |= X_OK;
-      #else
-        mode |= 1;
-      #endif
+    if (CheckExecute) {
+        mode |= MODE_EXECUTE;
     }
   #endif
-    if (ML_access_types_includes_write(AccessTypes)) {
-  #ifdef W_OK
-        mode |= W_OK;
-  #else
-        mode |= 2;
-  #endif
+    if (CheckWrite) {
+        mode |= MODE_WRITE;
     }
-    if (ML_access_types_includes_read(AccessTypes)) {
-  #ifdef R_OK
-        mode |= R_OK;
-  #else
-        mode |= 4;
-  #endif
+    if (CheckRead) {
+        mode |= MODE_READ;
     }
 
   #ifdef MR_WIN32
@@ -3577,36 +3471,34 @@ check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
   #endif
 
     if (access_result == 0) {
-        Result = ML_make_io_res_0_ok();
+        Error = 0;
     } else {
-        ML_make_io_res_0_error(errno,
-            MR_make_string_const(""file not accessible: ""), &Result);
+        Error = errno;
     }
 #else /* !MR_HAVE_ACCESS */
-    Result = ML_make_io_res_0_error_msg(
-        ""io.check_file_accessibility not supported on this platform"");
+    Error = ENOSYS;
 #endif
 ").
 
 :- pragma foreign_proc("Java",
-    check_file_accessibility_2(FileName::in, AccessTypes::in,
-        Result::out, _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    check_file_accessibility_2(FileName::in, CheckRead::in, CheckWrite::in,
+        CheckExecute::in, Error::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         may_not_duplicate],
 "
     java.io.File file = new java.io.File(FileName);
     try {
         boolean ok = true;
 
-        if (ML_access_types_includes_read(AccessTypes)) {
+        if (CheckRead == bool.YES) {
             ok = file.canRead();
         }
 
-        if (ok && ML_access_types_includes_write(AccessTypes)) {
+        if (ok && CheckWrite == bool.YES) {
             ok = file.canWrite();
         }
 
-        if (ok && ML_access_types_includes_execute(AccessTypes)) {
+        if (ok && CheckExecute == bool.YES) {
             // File.canExecute() was added in Java 1.6 but we only require
             // Java 1.5.
             try {
@@ -3626,42 +3518,38 @@ check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
         }
 
         if (ok) {
-            Result = ML_make_io_res_0_ok();
+            Error = null;
         } else {
-            Result = ML_make_io_res_0_error_msg(
-                ""file not accessible: Permission denied"");
+            Error = new java.io.FileNotFoundException(""Permission denied"");
         }
     }
-    catch (java.lang.SecurityException e) {
-        Result = ML_make_io_res_0_error_msg(e.toString());
+    catch (java.lang.Exception e) {
+        Error = e;
     }
 ").
 
 :- pragma foreign_proc("Erlang",
-    check_file_accessibility_2(FileName::in, AccessTypes::in, Result::out,
-        _IO0::di, _IO::uo),
-    [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+    check_file_accessibility_2(FileName::in, CheckRead::in, CheckWrite::in,
+        _CheckExecute::in, Error::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
         does_not_affect_liveness, may_not_duplicate],
 "
     FileNameStr = binary_to_list(FileName),
     case file:read_file_info(FileNameStr) of
         {ok, FileInfo} ->
             Access = FileInfo#file_info.access,
-            case mercury__io:'ML_access_types_includes_read'(AccessTypes) of
-                {} ->
+            case CheckRead of
+                {yes} ->
                     Ok0 = lists:member(Access, [read, read_write]);
-                fail ->
+                {no} ->
                     Ok0 = true
             end,
             case Ok0 of
                 true ->
-                    case
-                        mercury__io:'ML_access_types_includes_write'(
-                            AccessTypes)
-                    of
-                        {} ->
+                    case CheckWrite of
+                        {yes} ->
                             Ok = lists:member(Access, [write, read_write]);
-                        fail ->
+                        {no} ->
                             Ok = true
                     end;
                 false ->
@@ -3670,18 +3558,18 @@ check_file_accessibility(FileName, AccessTypes, Result, !IO) :-
             % XXX test execute access somehow
             case Ok of
                 true ->
-                    Result = mercury__io:'ML_make_io_res_0_ok'();
+                    Error = ok;
                 false ->
-                    Result = mercury__io:'ML_make_io_res_0_error'(eacces,
-                        <<""file not accessible: "">>)
+                    Error = {error, eacces}
             end
     ;
         {error, Reason} ->
-            Result = mercury__io:'ML_make_io_res_0_error'(Reason,
-                <<""file not accessible: "">>)
+            Error = {error, Reason}
     end
 ").
 
+    % XXX why not write this as check_file_accessibility_2?
+    %
 :- pred check_file_accessibility_dotnet(string::in, list(access_type)::in,
     io.res::out, io::di, io::uo) is det.
 
@@ -3689,10 +3577,9 @@ check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
     % The .NET CLI doesn't provide an equivalent of access(), so we have to
     % try to open the file to see if it is accessible.
 
-    CheckRead0 = pred_to_bool(access_types_includes_read(AccessTypes)),
-    CheckWrite = pred_to_bool(access_types_includes_write(AccessTypes)),
-
-    CheckExec = pred_to_bool(access_types_includes_execute(AccessTypes)),
+    CheckRead0 = pred_to_bool(contains(AccessTypes, read)),
+    CheckWrite = pred_to_bool(contains(AccessTypes, write)),
+    CheckExec = pred_to_bool(contains(AccessTypes, execute)),
     % We need to be able to read a file to execute it.
     CheckRead = bool.or(CheckRead0, CheckExec),
 
@@ -3701,7 +3588,12 @@ check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
         FileTypeRes = ok(FileType),
         ( if FileType = directory then
             check_directory_accessibility_dotnet(FileName,
-                to_int(CheckRead), to_int(CheckWrite), Result, !IO)
+                CheckRead, CheckWrite, Error, !IO),
+            ( if is_error(Error, "file not accessible: ", Message) then
+                Result = error(io_error(Message))
+            else
+                Result = ok
+            )
         else
             (
                 CheckRead = yes,
@@ -3741,7 +3633,12 @@ check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
                 % directory.
                 CheckExec = yes
             then
-                have_dotnet_exec_permission(Result, !IO)
+                have_dotnet_exec_permission(Error, !IO),
+                ( if is_error(Error, "file not accessible: ", Message) then
+                    Result = error(io_error(Message))
+                else
+                    Result = ok
+                )
             else
                 Result = CheckWriteRes
             )
@@ -3751,62 +3648,60 @@ check_file_accessibility_dotnet(FileName, AccessTypes, Result, !IO) :-
         Result = error(FileTypeError)
     ).
 
-:- pred have_dotnet_exec_permission(io.res::out, io::di, io::uo) is det.
+:- pred have_dotnet_exec_permission(system_error::out, io::di, io::uo) is det.
 
-have_dotnet_exec_permission(Res, !IO) :-
+have_dotnet_exec_permission(Error, !IO) :-
     % Avoid determinism warnings.
     ( if semidet_succeed then
         error("io.have_dotnet_exec_permission invoked " ++
             "for non-.NET CLI backend")
     else
         % Never reached.
-        Res = ok
+        Error = no_error
     ).
 
 :- pragma foreign_proc("C#",
-    have_dotnet_exec_permission(Result::out, _IO0::di, _IO::uo),
-    [promise_pure, may_call_mercury, thread_safe, terminates],
-"{
+    have_dotnet_exec_permission(Error::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
     try {
-        // We need unrestricted permissions to execute
-        // unmanaged code.
+        // We need unrestricted permissions to execute unmanaged code.
         (new System.Security.Permissions.SecurityPermission(
             System.Security.Permissions.SecurityPermissionFlag.
             AllFlags)).Demand();
-        Result = io.ML_make_io_res_0_ok();
+        Error = null;
     } catch (System.Exception e) {
-        Result = io.ML_make_io_res_0_error(e,
-            ""execute permission check failed: "");
+        Error = e;
     }
+").
 
-}").
-
-:- pred check_directory_accessibility_dotnet(string::in, int::in, int::in,
-    io.res::out, io::di, io::uo) is det.
+:- pred check_directory_accessibility_dotnet(string::in, bool::in, bool::in,
+    system_error::out, io::di, io::uo) is det.
 
-check_directory_accessibility_dotnet(_, _, _, Res, !IO) :-
+check_directory_accessibility_dotnet(_, _, _, Error, !IO) :-
     % Avoid determinism warnings.
     ( if semidet_succeed then
         error("io.check_directory_accessibility_dotnet called " ++
             "for non-.NET CLI backend")
     else
         % Never reached.
-        Res = ok
+        Error = no_error
     ).
 
 :- pragma foreign_proc("C#",
     check_directory_accessibility_dotnet(FileName::in, CheckRead::in,
-        CheckWrite::in, Result::out, _IO0::di, _IO::uo),
-    [promise_pure, may_call_mercury, tabled_for_io, thread_safe, terminates],
-"{
+        CheckWrite::in, Error::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
     try {
-        if (CheckRead != 0) {
+        Error = null;
+        if (CheckRead == mr_bool.YES) {
             // XXX This is less efficient than I would like.
             // Unfortunately the .NET CLI has no function
             // corresponding to access() or opendir().
             System.IO.Directory.GetFileSystemEntries(FileName);
         }
-        if (CheckWrite != 0) {
+        if (CheckWrite == mr_bool.YES) {
             // This will fail if the .NET CLI security regime
             // we're operating under doesn't allow writing
             // to the file. Even if this succeeds, the file
@@ -3825,120 +3720,15 @@ check_directory_accessibility_dotnet(_, _, _, Res, !IO) :-
             if ((attrs & System.IO.FileAttributes.ReadOnly) ==
                 System.IO.FileAttributes.ReadOnly)
             {
-                throw (new System.Exception(""file is read-only""));
+                Error = new System.Exception(""file is read-only"");
             }
         }
-        Result = io.ML_make_io_res_0_ok();
     } catch (System.Exception e) {
-        Result = io.ML_make_io_res_0_error(e, ""permission check failed: "");
+        Error = e;
     }
-}").
-
-:- pred access_types_includes_read(list(access_type)::in) is semidet.
-:- pragma foreign_export("C", access_types_includes_read(in),
-    "ML_access_types_includes_read").
-:- pragma foreign_export("C#", access_types_includes_read(in),
-    "ML_access_types_includes_read").
-:- pragma foreign_export("Java", access_types_includes_read(in),
-    "ML_access_types_includes_read").
-:- pragma foreign_export("Erlang", access_types_includes_read(in),
-    "ML_access_types_includes_read").
-
-access_types_includes_read(Access) :-
-    list.member(read, Access).
-
-:- pred access_types_includes_write(list(access_type)::in) is semidet.
-:- pragma foreign_export("C", access_types_includes_write(in),
-    "ML_access_types_includes_write").
-:- pragma foreign_export("C#", access_types_includes_write(in),
-    "ML_access_types_includes_write").
-:- pragma foreign_export("Java", access_types_includes_write(in),
-    "ML_access_types_includes_write").
-:- pragma foreign_export("Erlang", access_types_includes_write(in),
-    "ML_access_types_includes_write").
-
-access_types_includes_write(Access) :-
-    list.member(write, Access).
-
-:- pred access_types_includes_execute(list(access_type)::in) is semidet.
-:- pragma foreign_export("C", access_types_includes_execute(in),
-    "ML_access_types_includes_execute").
-:- pragma foreign_export("C#", access_types_includes_execute(in),
-    "ML_access_types_includes_execute").
-:- pragma foreign_export("Java", access_types_includes_execute(in),
-    "ML_access_types_includes_execute").
-:- pragma foreign_export("Erlang", access_types_includes_execute(in),
-    "ML_access_types_includes_execute").
-
-access_types_includes_execute(Access) :-
-    list.member(execute, Access).
-
-:- func make_io_res_0_ok = io.res.
-:- pragma foreign_export("C", (make_io_res_0_ok = out),
-    "ML_make_io_res_0_ok").
-:- pragma foreign_export("C#", (make_io_res_0_ok = out),
-    "ML_make_io_res_0_ok").
-:- pragma foreign_export("Java", (make_io_res_0_ok = out),
-    "ML_make_io_res_0_ok").
-:- pragma foreign_export("Erlang", (make_io_res_0_ok = out),
-    "ML_make_io_res_0_ok").
-
-make_io_res_0_ok = ok.
-
-:- pred make_io_res_0_error(io.system_error::in, string::in, io.res::out,
-    io::di, io::uo) is det.
-:- pragma foreign_export("C", make_io_res_0_error(in, in, out, di, uo),
-    "ML_make_io_res_0_error").
-:- pragma foreign_export("C#", make_io_res_0_error(in, in, out, di, uo),
-    "ML_make_io_res_0_error").
-:- pragma foreign_export("Java", make_io_res_0_error(in, in, out, di, uo),
-    "ML_make_io_res_0_error").
-:- pragma foreign_export("Erlang", make_io_res_0_error(in, in, out, di, uo),
-    "ML_make_io_res_0_error").
-
-make_io_res_0_error(Error, Msg0, error(make_io_error(Msg)), !IO) :-
-    io.make_err_msg(Error, Msg0, Msg, !IO).
-
-:- func make_io_res_0_error_msg(string) = io.res.
-:- pragma foreign_export("C", (make_io_res_0_error_msg(in) = out),
-    "ML_make_io_res_0_error_msg").
-:- pragma foreign_export("C#", (make_io_res_0_error_msg(in) = out),
-    "ML_make_io_res_0_error_msg").
-:- pragma foreign_export("Java", (make_io_res_0_error_msg(in) = out),
-    "ML_make_io_res_0_error_msg").
-
-make_io_res_0_error_msg(Msg) = error(make_io_error(Msg)).
-
-:- func make_io_res_1_ok_file_type(file_type) = io.res(file_type).
-:- pragma foreign_export("C", (make_io_res_1_ok_file_type(in) = out),
-    "ML_make_io_res_1_ok_file_type").
-:- pragma foreign_export("C#", (make_io_res_1_ok_file_type(in) = out),
-    "ML_make_io_res_1_ok_file_type").
-:- pragma foreign_export("Java", (make_io_res_1_ok_file_type(in) = out),
-    "ML_make_io_res_1_ok_file_type").
-:- pragma foreign_export("Erlang", (make_io_res_1_ok_file_type(in) = out),
-    "ML_make_io_res_1_ok_file_type").
-
-make_io_res_1_ok_file_type(FileType) = ok(FileType).
-
-:- pred make_io_res_1_error_file_type(io.system_error::in,
-    string::in, io.res(file_type)::out, io::di, io::uo) is det.
-:- pragma foreign_export("C",
-    make_io_res_1_error_file_type(in, in, out, di, uo),
-    "ML_make_io_res_1_error_file_type").
-:- pragma foreign_export("C#",
-    make_io_res_1_error_file_type(in, in, out, di, uo),
-    "ML_make_io_res_1_error_file_type").
-:- pragma foreign_export("Java",
-    make_io_res_1_error_file_type(in, in, out, di, uo),
-    "ML_make_io_res_1_error_file_type").
-:- pragma foreign_export("Erlang",
-    make_io_res_1_error_file_type(in, in, out, di, uo),
-    "ML_make_io_res_1_error_file_type").
-
-make_io_res_1_error_file_type(Error, Msg0, error(make_io_error(Msg)), !IO) :-
-    io.make_err_msg(Error, Msg0, Msg, !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").
@@ -3951,6 +3741,7 @@ make_io_res_1_error_file_type(Error, Msg0, error(make_io_error(Msg)), !IO) :-
 
 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",
@@ -3969,25 +3760,6 @@ make_io_res_1_ok_string(String) = ok(String).
 make_io_res_1_error_string(Error, Msg0, error(make_io_error(Msg)), !IO) :-
     io.make_err_msg(Error, Msg0, Msg, !IO).
 
-:- func make_io_maybe_partial_res_1_ok_string(string)
-    = io.maybe_partial_res(string).
-:- pragma foreign_export("Java",
-    (make_io_maybe_partial_res_1_ok_string(in) = out),
-    "ML_make_io_maybe_partial_res_1_ok_string").
-
-make_io_maybe_partial_res_1_ok_string(String) = ok(String).
-
-:- pred make_io_maybe_partial_res_1_error_string(string::in,
-    io.system_error::in, string::in, io.maybe_partial_res(string)::out,
-    io::di, io::uo) is det.
-:- pragma foreign_export("Java",
-    make_io_maybe_partial_res_1_error_string(in, in, in, out, di, uo),
-    "ML_make_io_maybe_partial_res_1_error_string").
-
-make_io_maybe_partial_res_1_error_string(Partial, Error, Msg0, Res, !IO) :-
-    io.make_err_msg(Error, Msg0, Msg, !IO),
-    Res = error(Partial, make_io_error(Msg)).
-
 %---------------------------------------------------------------------------%
 
 :- type file_id ---> file_id.
-- 
2.9.0



More information about the reviews mailing list