[m-rev.] for review: Add future datatype for concurrent and parallel programming

Paul Bone paul at bone.id.au
Mon Oct 6 16:30:39 AEDT 2014


Branches: master.

For review by anyone.

---

Add future datatype for concurrent and parallel programming

library/library.m:
library/thread.future.m:
library/thread.m:
    Add new future standard library module.

NEWS:
    Announce the new addition.

library/thread.semaphore.m:
    Add an impure interface to thread.semaphore.m.  Semaphores are used to
    implement our other concurrency primatives and an impure interface can
    often be useful to implement things such as futures, which don't require
    IO state threading.

benchmarks/progs/mandelbrot/mandelbrot.m:
benchmarks/progs/mandelbrot/bench.sh:
    Add future example to mandelbrot benchmark.
---
 NEWS                                     |   5 +-
 benchmarks/progs/mandelbrot/bench.sh     |   2 +-
 benchmarks/progs/mandelbrot/mandelbrot.m |  66 +++++----
 library/library.m                        |   1 +
 library/thread.future.m                  | 238 +++++++++++++++++++++++++++++++
 library/thread.m                         |   1 +
 library/thread.semaphore.m               | 112 ++++++++++-----
 7 files changed, 358 insertions(+), 67 deletions(-)
 create mode 100644 library/thread.future.m

diff --git a/NEWS b/NEWS
index 751af65..b37a4f3 100644
--- a/NEWS
+++ b/NEWS
@@ -24,8 +24,9 @@ Changes to the Mercury standard library:
   highly efficient set implementation for fat sets.  This module is a
   contribution from Yes Logic Pty. Ltd.
 
-* We have added a module that implements barriers for concurrent
-  programming.  This module is a contribution from Mission Critical IT.
+* We have added two new modules for concurrent programming.  They implement
+  barriers and futures respectively.  These modules are contributed by
+  Mission Critical IT.
 
 * We have added thread.spawn_native/4 to dedicate an OS thread to a Mercury
   thread. thread.spawn/4 was added as well.
diff --git a/benchmarks/progs/mandelbrot/bench.sh b/benchmarks/progs/mandelbrot/bench.sh
index e648798..531a6de 100755
--- a/benchmarks/progs/mandelbrot/bench.sh
+++ b/benchmarks/progs/mandelbrot/bench.sh
@@ -11,7 +11,7 @@ MEMORY=$((3*1024*1024*1024))
 ulimit -S -m $MEMORY -v $MEMORY 
 
 for PROGRAM in "$@"; do
-    for MODE in no spawn_native spawn conj; do
+    for MODE in no spawn_native spawn future; do
         echo Testing $PROGRAM -p $MODE
         LOG=${PROGRAM}_${MODE}.log
         rm -f $LOG
diff --git a/benchmarks/progs/mandelbrot/mandelbrot.m b/benchmarks/progs/mandelbrot/mandelbrot.m
index 93c2e87..d4635f9 100644
--- a/benchmarks/progs/mandelbrot/mandelbrot.m
+++ b/benchmarks/progs/mandelbrot/mandelbrot.m
@@ -21,6 +21,7 @@
 :- import_module require.
 :- import_module string.
 :- import_module thread.
+:- import_module thread.future.
 :- import_module thread.mvar.
 
 main(!IO) :-
@@ -115,6 +116,7 @@ default_options(parallel,               string("no")).
     --->    parallel_conj
     ;       parallel_spawn
     ;       parallel_spawn_native
+    ;       parallel_future
     ;       sequential.
 
 :- pred process_options(option_table(option)::in, maybe_error(options)::out)
@@ -143,13 +145,16 @@ process_options(Table, MaybeOptions) :-
         ;
             ParallelStr = "spawn_native",
             Parallel0 = parallel_spawn_native
+        ;
+            ParallelStr = "future",
+            Parallel0 = parallel_future
         )
     ->
         MaybeParallel = ok(Parallel0)
     ;
         MaybeParallel = error(
-            "Parallel must be one of ""no"", ""conj"", ""spawn"" or " ++
-            """spawn_native""")
+            "Parallel must be one of ""no"", ""conj"", ""spawn"", " ++
+            """spawn_native"" or ""future""")
     ),
 
     getopt.lookup_maybe_int_option(Table, dim_x, MaybeX),
@@ -198,9 +203,11 @@ usage(!IO) :-
         "\t\tThe dimensions of the image, specify neither or both\n", !IO),
     write_string("\t-p <how> --parallel <how>\n", !IO),
     write_string(
-        "\t\t<how> is one of ""no"", ""conj"", ""spawn"" or\n", !IO),
+        "\t\t<how> is one of ""no"", ""conj"", ""spawn"",\n", !IO),
+    write_string(
+        "\t\t""spawn_native"" or ""future"". These may be grade", !IO),
     write_string(
-        "\t\t""spawn_native"". These may be grade dependent.\n", !IO),
+        "\t\tdependent.\n", !IO),
     write_string("\t-d --dependent-conjunctions\n", !IO),
     write_string(
         "\t\tUse an accumulator to represent the rows rendered so far\n", !IO).
@@ -241,14 +248,20 @@ draw_rows(Options, StartY, StepY, DimY, StartX, StepX, DimX, Rows) :-
 :- pred draw_rows_dep(parallel::in, list(float)::in, list(float)::in,
     cord(colour)::out) is det.
 
-draw_rows_dep(sequential, Xs, Ys, Rows) :-
-    map_foldl(draw_row(Xs), append_row, Ys, empty, Rows).
-draw_rows_dep(parallel_conj, Xs, Ys, Rows) :-
-    map_foldl_par_conj(draw_row(Xs), append_row, Ys, empty, Rows).
-draw_rows_dep(parallel_spawn, Xs, Ys, Rows) :-
-    map_foldl_par_spawn(draw_row(Xs), append_row, Ys, empty, Rows).
-draw_rows_dep(parallel_spawn_native, Xs, Ys, Rows) :-
-    map_foldl_par_spawn_native(draw_row(Xs), append_row, Ys, empty, Rows).
+draw_rows_dep(Parallel, Xs, Ys, Rows) :-
+    (
+        Parallel = sequential,
+        map_foldl(draw_row(Xs), append_row, Ys, empty, Rows)
+    ;
+        Parallel = parallel_conj,
+        map_foldl_par_conj(draw_row(Xs), append_row, Ys, empty, Rows)
+    ;
+        ( Parallel = parallel_spawn
+        ; Parallel = parallel_spawn_native
+        ; Parallel = parallel_future
+        ),
+        sorry($file, $pred, string(Parallel))
+    ).
 
 :- pred draw_rows_indep(parallel::in, list(float)::in, list(float)::in,
     cord(colour)::out) is det.
@@ -270,6 +283,9 @@ draw_rows_indep(Parallel, Xs, Ys, Rows) :-
         promise_equivalent_solutions [RowList] (
             my_map_par_spawn_native(draw_row(Xs), Ys, RowList)
         )
+    ;
+        Parallel = parallel_future,
+        my_map_par_future(draw_row(Xs), Ys, RowList)
     ),
     foldl(append_row, RowList, empty, Rows).
 
@@ -375,22 +391,6 @@ map_foldl_par_conj(M, F, [X | Xs], !Acc) :-
         map_foldl_par_conj(M, F, Xs, !Acc)
     ).
 
-:- pred map_foldl_par_spawn(pred(X, Y), pred(Y, A, A), list(X), A, A).
-:- mode map_foldl_par_spawn(pred(in, out) is det, pred(in, in, out) is det,
-    in, in, out) is erroneous.
-
-map_foldl_par_spawn(_, _, _, !Acc) :-
-    % XXX: Do the parallel conjunction transformation by hand.
-    sorry($file, $pred, "Unimplemented").
-
-:- pred map_foldl_par_spawn_native(pred(X, Y), pred(Y, A, A), list(X), A, A).
-:- mode map_foldl_par_spawn_native(pred(in, out) is det,
-    pred(in, in, out) is det, in, in, out) is erroneous.
-
-map_foldl_par_spawn_native(_, _, _, !Acc) :-
-    % XXX: Do the parallel conjunction transformation by hand.
-    sorry($file, $pred, "Unimplemented").
-
 :- pred my_map(pred(X, Y), list(X), list(Y)).
 :- mode my_map(pred(in, out) is det, in, out) is det.
 
@@ -407,6 +407,16 @@ my_map_par_conj(M, [X | Xs], [Y | Ys]) :-
     M(X, Y) &
     my_map_par_conj(M, Xs, Ys).
 
+:- pred my_map_par_future(pred(X, Y), list(X), list(Y)).
+:- mode my_map_par_future(pred(in, out) is det, in, out) is det.
+
+my_map_par_future(_, [], []).
+my_map_par_future(M, [X | Xs], Ys) :-
+    FutY = future((func) = Y0 :- M(X, Y0)),
+    my_map_par_future(M, Xs, Ys0),
+    Y = wait(FutY),
+    Ys = [Y | Ys0].
+
 :- pred my_map_par_spawn(pred(X, Y), list(X), list(Y)).
 :- mode my_map_par_spawn(pred(in, out) is det, in, out) is cc_multi.
 
diff --git a/library/library.m b/library/library.m
index ce0caee..7ad74dc 100644
--- a/library/library.m
+++ b/library/library.m
@@ -301,6 +301,7 @@ mercury_std_library_module("time").
 mercury_std_library_module("thread").
 mercury_std_library_module("thread.barrier").
 mercury_std_library_module("thread.channel").
+mercury_std_library_module("thread.future").
 mercury_std_library_module("thread.mvar").
 mercury_std_library_module("thread.semaphore").
 mercury_std_library_module("tree234").
diff --git a/library/thread.future.m b/library/thread.future.m
new file mode 100644
index 0000000..45d05dd
--- /dev/null
+++ b/library/thread.future.m
@@ -0,0 +1,238 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2014 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.
+%-----------------------------------------------------------------------------%
+%
+% File: thread.future.m.
+% Authors: pbone.
+% Stability: low.
+%
+% This module defines a future datatype for parallel and concurrent
+% programming.
+%
+% A future represents a value that may or may-not exist yet.  There are two
+% styles of futures.  A future can be set exactly once, but can be read a
+% number of times, this allows the implementor to use a more efficient
+% algorithm than for mvars.
+%
+% There are two ways to use futures.  The first is to create a future,
+% and supply it's value as separate steps.  This is the most flexible way
+% but requires use of the IO state:
+%
+%  First:
+%    future(Fut, !IO),
+%
+%  Then in a seperate thread:
+%    signal(Fut, Value0, !IO),
+%
+%  Finally, in the original thread:
+%    wait(Fut, Value, !IO),
+%
+% This is flexible because a thread can do more than provide a single future
+% value, it can provide many future values or use any other concurrency
+% feature such as mvars or channels, or do any IO operation.
+%
+% The alternative is to create the future and supply a function which when
+% evaluated will produce the value.  This is pure (and similar to a lazy
+% value) and therefore does not require the IO state.  The spawning of the
+% thread is done on behalf of the caller.
+%
+%  Just do:
+%    Future = future(SomeFunction),
+%    ... do something in the meantime ...
+%    Value = wait(Future).
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module thread.future.
+:- interface.
+
+    % future/1 represents a value that is evaluated in a separate thread
+    % (using spawn/3).
+    %
+:- type future(T).
+
+%-----------------------------------------------------------------------------%
+
+    % Create a new empty future.
+    %
+:- pred init(future(T)::uo, io::di, io::uo) is det.
+
+    % Provide a value for the future and signal any waiting threads.  Any
+    % further calls to wait will return immediatly.
+    %
+:- pred signal(future(T)::in, T::in, io::di, io::uo) is det.
+
+    % Return the future's value, potentially blocking until the future is
+    % signaled.
+    %
+:- pred wait(future(T)::in, T::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+    % Create a future which has the value that the closure, when evaluated,
+    % will produce.
+    %
+:- func future((func) = T) = future(T).
+
+    % Return the value of the future, potentially blocking until the value
+    % is available.
+    %
+    % This is pure and does not require IO because if it terminates it
+    % always returns the same value.
+    %
+:- func wait(future(T)) = T.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module thread.semaphore.
+:- import_module mutvar.
+
+:- type future(T)
+    --->    future(
+                f_ready         :: mutvar(ready),
+                    % f_ready can be used to optimistically avoid locking.
+
+                f_wait          :: semaphore,
+                f_value         :: mutvar(T)
+            ).
+
+:- type ready
+    --->    ready
+    ;       not_ready.
+
+:- pragma promise_pure(init/3).
+init(Future, !IO) :-
+    impure init(Future).
+
+:- impure pred init(future(T)::uo) is det.
+
+init(future(Ready, Wait, Value)) :-
+    impure new_mutvar(not_ready, Ready),
+    impure init(Wait),
+    impure new_mutvar0(Value).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma promise_pure(signal/4).
+signal(Future, Value, !IO) :-
+    impure signal(Future, Value).
+
+:- impure pred signal(future(T)::in, T::in) is det.
+
+signal(future(Ready, Wait, MValue), Value) :-
+    impure set_mutvar(MValue, Value),
+    impure set_mutvar(Ready, ready),
+    % TODO: Implement signal_all.
+    impure signal(Wait).
+
+%-----------------------------------------------------------------------------%
+
+wait(Future, Value, !IO) :-
+    wait(Future, Value).
+
+    % Wait is pure because it always returns the same value for the same
+    % future (if it terminates).
+    %
+:- pred wait(future(T)::in, T::out) is det.
+:- pragma promise_pure(wait/2).
+
+wait(Future, Value) :-
+    Future = future(MReady, Wait, MValue),
+    impure get_mutvar(MReady, Ready),
+    (
+        Ready = ready
+        % No wait necessary
+    ;
+        Ready = not_ready,
+        % We need to wait, this will probably block.
+        impure wait(Wait),
+        % Signal the semaphore to release the next waiting thread.
+        impure signal(Wait)
+    ),
+    impure get_mutvar(MValue, Value).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pragma promise_pure(future/1).
+future(Func) = Future :-
+    impure init(Future),
+    impure spawn_impure(run_future(Future, Func)).
+
+:- pragma no_determinism_warning(run_future/4).
+:- pred run_future(future(T), (func) = T, io, io).
+:- mode run_future(in, ((func) = out) is det, di, uo) is cc_multi.
+
+run_future(Future, Func, !IO) :-
+    signal(Future, apply(Func), !IO).
+
+wait(Future) = Value :-
+    wait(Future, Value).
+
+%-----------------------------------------------------------------------------%
+
+:- impure pred spawn_impure(pred(io, io)).
+:-        mode spawn_impure(pred(di, uo) is cc_multi) is det.
+
+spawn_impure(Task) :-
+    some [!IO] (
+        impure make_io(!:IO),
+        promise_equivalent_solutions [!:IO] (
+            spawn(Task, !IO)
+        ),
+        impure destroy_io(!.IO)
+    ).
+
+:- impure pred make_io(io::uo) is det.
+
+:- pragma foreign_proc("C",
+    make_io(IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "/* IO */").
+:- pragma foreign_proc("C#",
+    make_io(IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "// IO").
+:- pragma foreign_proc("Java",
+    make_io(IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "// IO").
+
+:- impure pred destroy_io(io::di) is det.
+
+:- pragma foreign_proc("C",
+    destroy_io(IO::di),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "/* IO */").
+:- pragma foreign_proc("C#",
+    destroy_io(IO::di),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "// IO").
+:- pragma foreign_proc("Java",
+    destroy_io(IO::di),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "// IO").
+
+:- impure pred touch_io(io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    touch_io(_IO0::di, _IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "").
+:- pragma foreign_proc("C#",
+    touch_io(_IO0::di, _IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "").
+:- pragma foreign_proc("Java",
+    touch_io(_IO0::di, _IO::uo),
+    [will_not_call_mercury, thread_safe, tabled_for_io],
+    "").
+
+%-----------------------------------------------------------------------------%
diff --git a/library/thread.m b/library/thread.m
index 154a268..ab8daf8 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -28,6 +28,7 @@
 
 :- include_module barrier.
 :- include_module channel.
+:- include_module future.
 :- include_module mvar.
 :- include_module semaphore.
 
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index 46c53e2..f886121 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -28,33 +28,41 @@
 
 :- type semaphore.
 
-    % init(Sem, !IO) creates a new semaphore `Sem' with its counter
-    % initialized to 0.
+    % init(Sem, Count, !IO) creates a new semaphore `Sem' with its counter
+    % initialized to Count.
     %
-:- pred semaphore.init(semaphore::out, io::di, io::uo) is det.
+:- pred init(semaphore::uo, int::in, io::di, io::uo) is det.
+:- impure pred init(semaphore::uo, int::in) is det.
+:- impure func init(int::in) = (semaphore::uo) is det.
 
-    % Returns a new semaphore `Sem' with its counter initialized to Count.
+    % init(Sem, !IO) creates a new semaphore `Sem' with its counter
+    % initialized to 0.
     %
-:- impure func semaphore.init(int::in) = (semaphore::uo) is det.
+:- pred init(semaphore::uo, io::di, io::uo) is det.
+:- impure pred init(semaphore::uo) is det.
+:- impure func init = (semaphore::uo) is det.
 
     % wait(Sem, !IO) blocks until the counter associated with `Sem'
     % becomes greater than 0, whereupon it wakes, decrements the
     % counter and returns.
     %
-:- pred semaphore.wait(semaphore::in, io::di, io::uo) is det.
+:- pred wait(semaphore::in, io::di, io::uo) is det.
+:- impure pred wait(semaphore::in) is det.
 
     % try_wait(Sem, Succ, !IO) is the same as wait/3, except that
     % instead of blocking, it binds `Succ' to a boolean indicating
     % whether the call succeeded in obtaining the semaphore or not.
     %
-:- pred semaphore.try_wait(semaphore::in, bool::out, io::di, io::uo) is det.
+:- pred try_wait(semaphore::in, bool::out, io::di, io::uo) is det.
+:- impure pred try_wait(semaphore::in, bool::out) is det.
 
     % signal(Sem, !IO) increments the counter associated with `Sem'
     % and if the resulting counter has a value greater than 0, it wakes
     % one or more coroutines that are waiting on this semaphore (if
     % any).
     %
-:- pred semaphore.signal(semaphore::in, io::di, io::uo) is det.
+:- pred signal(semaphore::in, io::di, io::uo) is det.
+:- impure pred signal(semaphore::in) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -106,13 +114,24 @@ ML_finalize_semaphore(void *obj, void *cd);
 
 %-----------------------------------------------------------------------------%
 
-init(Semaphore, !IO) :-
+init(Semaphore, Count, !IO) :-
     promise_pure (
-        impure Semaphore = init(0)
+        impure init(Semaphore, Count)
     ).
+init(Count) = Semaphore :-
+    impure init(Semaphore, Count).
+
+init(Semaphore, !IO) :-
+    init(Semaphore, 0, !IO).
+
+init(Semaphore) :-
+    impure init(Semaphore, 0).
+
+init = Semaphore :-
+    impure Semaphore = init(0).
 
 :- pragma foreign_proc("C",
-    init(Count::in) = (Semaphore::uo),
+    init(Semaphore::uo, Count::in),
     [will_not_call_mercury, thread_safe],
 "
     ML_Semaphore    *sem;
@@ -142,7 +161,7 @@ init(Semaphore, !IO) :-
 ").
 
 :- pragma foreign_proc("C#",
-    init(Count::in) = (Semaphore::uo),
+    init(Semaphore::uo, Count::in),
     [will_not_call_mercury, thread_safe],
 "
     Semaphore = new thread__semaphore.ML_Semaphore();
@@ -150,7 +169,7 @@ init(Semaphore, !IO) :-
 ").
 
 :- pragma foreign_proc("Java",
-    init(Count::in) = (Semaphore::uo),
+    init(Semaphore::uo, Count::in),
     [will_not_call_mercury, thread_safe],
 "
     Semaphore = new jmercury.runtime.Semaphore(Count);
@@ -174,16 +193,23 @@ ML_finalize_semaphore(void *obj, void *cd)
 }
 ").
 
+%-----------------------------------------------------------------------------%
+
+signal(Semaphore, !IO) :-
+    promise_pure (
+        impure signal(Semaphore)
+    ).
+
     % semaphore.signal causes the calling context to resume in semaphore.nop,
     % which simply jumps to the succip. That will return control to the caller
     % of semaphore.signal as intended, but not if this procedure is inlined.
     %
     % XXX get rid of this limitation at some stage.
     %
-:- pragma no_inline(semaphore.signal/3).
+:- pragma no_inline(semaphore.signal/1).
 :- pragma foreign_proc("C",
-    signal(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    signal(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     ML_Semaphore    *sem;
 #ifndef MR_HIGHLEVEL_CODE
@@ -254,8 +280,8 @@ ML_finalize_semaphore(void *obj, void *cd)
 ").
 
 :- pragma foreign_proc("C#",
-    signal(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    signal(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     System.Threading.Monitor.Enter(Semaphore);
     Semaphore.count++;
@@ -265,22 +291,29 @@ ML_finalize_semaphore(void *obj, void *cd)
 ").
 
 :- pragma foreign_proc("Java",
-    signal(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    signal(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     Semaphore.release();
 ").
 
+%-----------------------------------------------------------------------------%
+
+wait(Semaphore, !IO) :-
+    promise_pure (
+        impure wait(Semaphore)
+    ).
+
     % semaphore.wait causes the calling context to resume in semaphore.nop,
     % which simply jumps to the succip. That will return control to the caller
     % of semaphore.wait as intended, but not if this procedure is inlined.
     %
     % XXX get rid of this limitation at some stage.
     %
-:- pragma no_inline(semaphore.wait/3).
+:- pragma no_inline(semaphore.wait/1).
 :- pragma foreign_proc("C",
-    wait(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    wait(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     ML_Semaphore    *sem;
 #ifndef MR_HIGHLEVEL_CODE
@@ -342,8 +375,8 @@ ML_finalize_semaphore(void *obj, void *cd)
 ").
 
 :- pragma foreign_proc("C#",
-    wait(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    wait(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     System.Threading.Monitor.Enter(Semaphore);
 
@@ -357,8 +390,8 @@ ML_finalize_semaphore(void *obj, void *cd)
 ").
 
 :- pragma foreign_proc("Java",
-    wait(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    wait(Semaphore::in),
+    [will_not_call_mercury, thread_safe],
 "
     /*
     ** acquire() might be useful as well; it will throw an exception if the
@@ -367,15 +400,22 @@ ML_finalize_semaphore(void *obj, void *cd)
     Semaphore.acquireUninterruptibly();
 ").
 
-semaphore.try_wait(Sem, Res, !IO) :-
-    try_wait_2(Sem, Res0, !IO),
+%-----------------------------------------------------------------------------%
+
+try_wait(Sem, Res, !IO) :-
+    promise_pure (
+        impure try_wait(Sem, Res)
+    ).
+
+try_wait(Sem, Res) :-
+    impure try_wait_2(Sem, Res0),
     Res = ( Res0 = 0 -> yes ; no ).
 
-:- pred try_wait_2(semaphore::in, int::out, io::di, io::uo) is det.
+:- impure pred try_wait_2(semaphore::in, int::out) is det.
 
 :- pragma foreign_proc("C",
-    try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    try_wait_2(Semaphore::in, Res::out),
+    [will_not_call_mercury, thread_safe],
 "
     ML_Semaphore    *sem;
 
@@ -393,8 +433,8 @@ semaphore.try_wait(Sem, Res, !IO) :-
 ").
 
 :- pragma foreign_proc("C#",
-    try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    try_wait_2(Semaphore::in, Res::out),
+    [will_not_call_mercury, thread_safe],
 "
     if (System.Threading.Monitor.TryEnter(Semaphore)) {
         if (Semaphore.count > 0) {
@@ -411,8 +451,8 @@ semaphore.try_wait(Sem, Res, !IO) :-
 ").
 
 :- pragma foreign_proc("Java",
-    try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+    try_wait_2(Semaphore::in, Res::out),
+    [will_not_call_mercury, thread_safe],
 "
     Res = Semaphore.tryAcquire() ? 0 : 1;
 ").
-- 
2.1.0




More information about the reviews mailing list