[m-rev.] for second review: Add future datatype for concurrent and parallel programming
Paul Bone
paul at bone.id.au
Thu Oct 9 00:19:26 AEDT 2014
Branches: master
For second review by Julien.
---
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. The impure interface predicate names are prefixed
with "impure_" an existing impure function is now marked as depprecated.
library/thread.mvar.m:
Conform to changes in semaphore.m.
benchmarks/progs/mandelbrot/mandelbrot.m:
Add future example to mandelbrot benchmark.
---
NEWS | 5 +-
benchmarks/progs/mandelbrot/mandelbrot.m | 66 +++++---
library/library.m | 1 +
library/thread.future.m | 282 +++++++++++++++++++++++++++++++
library/thread.m | 6 +-
library/thread.mvar.m | 5 +-
library/thread.semaphore.m | 142 +++++++++++-----
7 files changed, 434 insertions(+), 73 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/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..fde780d
--- /dev/null
+++ b/library/thread.future.m
@@ -0,0 +1,282 @@
+%-----------------------------------------------------------------------------%
+% 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 data type for parallel and concurrent
+% programming.
+%
+% A future represents a value that might 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 its value as separate steps. This is the most flexible way
+% but requires use of the IO state:
+%
+% First:
+% future(Fut, !IO),
+%
+% Then in a separate 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 will be computed by another thread.
+ %
+:- type future(T).
+
+ % Create a future which has the value that the closure, when evaluated,
+ % will produce. This function will create a thread to evaluate the
+ % closure using spawn/3.
+ %
+ % If the closure throws an exception, that exception will be rethrown by
+ % wait/1.
+ %
+:- func future((func) = T) = future(T).
+
+ % Return the value of the future, potentially blocking until the value
+ % is available.
+ %
+:- func wait(future(T)) = T.
+
+%-----------------------------------------------------------------------------%
+
+ % future_io/1 represents a value that may not have been computed yet.
+ % Future values are usually computed by separate threads (using
+ % spawn/3).
+ %
+ % Technically this is a promise however promise is a reserved word in
+ % Mercury. A promise's value can be provided by different calls to
+ % signal on different branches of execution.
+ %
+:- type future_io(T).
+
+ % Create a new empty future_io.
+ %
+:- pred init(future_io(T)::uo, io::di, io::uo) is det.
+
+ % Provide a value for the future_io and signal any waiting threads. Any
+ % further calls to wait will return immediately.
+ %
+ % Calling signal multiple times will result in undefined behaviour.
+ %
+:- pred signal(future_io(T)::in, T::in, io::di, io::uo) is det.
+
+ % Return the future_io's value, potentially blocking until it is
+ % signaled.
+ %
+:- pred wait(future_io(T)::in, T::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module exception.
+:- import_module thread.semaphore.
+:- import_module mutvar.
+
+%-----------------------------------------------------------------------------%
+
+:- type future(T)
+ ---> future(future_io(ok_or_exception(T))).
+
+:- type ok_or_exception(T)
+ ---> ok(T)
+ ; some [E] exception(E).
+
+:- pragma promise_pure(future/1).
+
+future(Func) = Future :-
+ impure init(FutureIO),
+ Future = future(FutureIO),
+ impure spawn_impure(run_future(Future, Func)).
+
+:- impure pred run_future(future(T), (func) = T).
+:- mode run_future(in, ((func) = out) is det) is cc_multi.
+
+run_future(future(Future), Func) :-
+ (
+ try [] (
+ Result = apply(Func)
+ )
+ then (
+ impure signal(Future, ok(Result))
+ )
+ catch_any Exp -> (
+ impure signal(Future, 'new exception'(Exp))
+ )
+ ).
+
+wait(future(Future)) = Value :-
+ wait(Future, Result),
+ (
+ Result = ok(Value)
+ ;
+ Result = exception(Exception),
+ throw(Exception)
+ ).
+
+:- impure pred spawn_impure(impure (pred)).
+:- mode spawn_impure((pred) is cc_multi) is det.
+
+spawn_impure(Task) :-
+ impure make_io_state(IO0),
+ promise_equivalent_solutions [IO] (
+ spawn(spawn_impure_2(Task), IO0, IO)
+ ),
+ impure consume_io_state(IO).
+
+:- pred spawn_impure_2(impure (pred), io, io).
+:- mode spawn_impure_2((pred) is cc_multi, di, uo) is cc_multi.
+:- pragma promise_pure(spawn_impure_2/3).
+
+spawn_impure_2(Task, !IO) :-
+ impure Task.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- type future_io(T)
+ ---> future_io(
+ f_ready :: mutvar(ready),
+ % f_ready is used to optimistically avoid locking. It
+ % is also used to try to detect multiple calls to
+ % signal/2.
+
+ 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_io(T)::uo) is det.
+
+init(future_io(Ready, Wait, Value)) :-
+ impure new_mutvar(not_ready, Ready),
+ impure semaphore.impure_init(Wait),
+ impure new_mutvar0(Value).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma promise_pure(signal/4).
+
+signal(Future, Value, !IO) :-
+ impure signal(Future, Value).
+
+:- impure pred signal(future_io(T)::in, T::in) is det.
+
+signal(future_io(MReady, Wait, MValue), Value) :-
+ impure get_mutvar(MReady, Ready),
+ (
+ Ready = not_ready,
+ impure set_mutvar(MValue, Value),
+ % TODO: Implement signal_all.
+ impure semaphore.impure_signal(Wait),
+ impure set_mutvar(MReady, ready)
+ ;
+ Ready = ready,
+ % It is possible that another thread has called signal/2 but we read
+ % Ready before it wrote it, resulting in multiple calls to signal/2.
+ % Therefore we do not guarantee that we will always detect multiple
+ % calls and will not always throw this exception.
+ error("Multiple calls to thread.future.signal/2")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+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_io(T)::in, T::out) is det.
+:- pragma promise_pure(wait/2).
+
+wait(Future, Value) :-
+ Future = future_io(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 semaphore.impure_wait(Wait),
+ % Signal the semaphore to release the next waiting thread.
+ impure semaphore.impure_signal(Wait)
+ ),
+ impure get_mutvar(MValue, Value).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+%
+% Copied from exception.m
+%
+
+:- impure pred make_io_state(io::uo) is det.
+:- pragma foreign_proc("C", make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe, will_not_modify_trail, no_sharing],
+ "").
+:- pragma foreign_proc("C#", make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Java", make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Erlang", make_io_state(_IO::uo),
+ [will_not_call_mercury, thread_safe], "void").
+
+:- impure pred consume_io_state(io::di) is det.
+:- pragma foreign_proc("C",
+ consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe, no_sharing], "").
+:- pragma foreign_proc("C#",
+ consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Java",
+ consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe], "").
+:- pragma foreign_proc("Erlang",
+ consume_io_state(_IO::di),
+ [will_not_call_mercury, thread_safe], "void").
+
+%-----------------------------------------------------------------------------%
diff --git a/library/thread.m b/library/thread.m
index 154a268..9864cf6 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -1,8 +1,9 @@
%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
-% Copyright (C) 2000-2001, 2003-2004, 2006-2008, 2010-2011, 2014 The
-% University of Melbourne.
+% Copyright (C) 2000-2001, 2003-2004, 2006-2008, 2010-2011 The % University
+% of Melbourne.
+% Copyright 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.
%-----------------------------------------------------------------------------%
@@ -28,6 +29,7 @@
:- include_module barrier.
:- include_module channel.
+:- include_module future.
:- include_module mvar.
:- include_module semaphore.
diff --git a/library/thread.mvar.m b/library/thread.mvar.m
index 42ae67a..93b99b5 100644
--- a/library/thread.mvar.m
+++ b/library/thread.mvar.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2003, 2006-2007, 2011 The University of Melbourne.
+% 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.
%-----------------------------------------------------------------------------%
@@ -90,8 +91,8 @@ mvar.init(Mvar, !IO) :-
).
mvar.init = mvar(Full, Empty, Ref) :-
- impure Full = semaphore.init(0),
- impure Empty = semaphore.init(1), % Initially a mvar starts empty.
+ impure semaphore.impure_init(0, Full),
+ impure semaphore.impure_init(1, Empty), % Initially a mvar starts empty.
impure new_mutvar0(Ref).
mvar.take(mvar(Full, Empty, Ref), Data, !IO) :-
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index 46c53e2..14f80e1 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -2,6 +2,7 @@
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2001,2003-2004, 2006-2007, 2009-2011 The University of Melbourne.
+% 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.
%-----------------------------------------------------------------------------%
@@ -28,40 +29,93 @@
:- type semaphore.
+ % init(Count, Sem, !IO) creates a new semaphore `Sem' with its counter
+ % initialized to Count.
+ %
+:- pred init(int::in, semaphore::uo, io::di, io::uo) is det.
+
% init(Sem, !IO) creates a new semaphore `Sem' with its counter
% initialized to 0.
%
-:- pred semaphore.init(semaphore::out, io::di, io::uo) is det.
+:- pred init(semaphore::uo, io::di, io::uo) is det.
- % Returns a new semaphore `Sem' with its counter initialized to Count.
+ % Sem = init(Count) returns a new semaphore `Sem' with its counter
+ % initialized to Count.
%
-:- impure func semaphore.init(int::in) = (semaphore::uo) is det.
+ % This has been renamed to impure_init.
+ %
+:- impure func init(int::in) = (semaphore::uo) is det.
+:- pragma obsolete(init/1).
% 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.
% 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.
% 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.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-
:- implementation.
+init(Count, Semaphore, !IO) :-
+ promise_pure (
+ impure impure_init(Count, Semaphore)
+ ).
+
+init(Semaphore, !IO) :-
+ init(0, Semaphore, !IO).
+
+init(Count) = Semaphore :-
+ impure impure_init(Count, Semaphore).
+
+signal(Semaphore, !IO) :-
+ promise_pure (
+ impure impure_signal(Semaphore)
+ ).
+
+wait(Semaphore, !IO) :-
+ promise_pure (
+ impure impure_wait(Semaphore)
+ ).
+
+try_wait(Sem, Res, !IO) :-
+ promise_pure (
+ impure impure_try_wait(Sem, Res)
+ ).
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- interface.
+
+% The semaphore operations above can be used without the IO state in impure
+% code.
+
+:- impure pred impure_init(int::in, semaphore::uo) is det.
+
+:- impure pred impure_init(semaphore::uo) is det.
+
+:- impure pred impure_wait(semaphore::in) is det.
+
+:- impure pred impure_try_wait(semaphore::in, bool::out) is det.
+
+:- impure pred impure_signal(semaphore::in) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
:- pragma foreign_decl("C", "
#include <stdio.h>
@@ -106,13 +160,17 @@ ML_finalize_semaphore(void *obj, void *cd);
%-----------------------------------------------------------------------------%
-init(Semaphore, !IO) :-
- promise_pure (
- impure Semaphore = init(0)
- ).
+%impure_init(Count) = Semaphore :-
+% impure init(Count, Semaphore).
+
+impure_init(Semaphore) :-
+ impure impure_init(0, Semaphore).
+
+%init = Semaphore :-
+% impure Semaphore = init(0).
:- pragma foreign_proc("C",
- init(Count::in) = (Semaphore::uo),
+ impure_init(Count::in, Semaphore::uo),
[will_not_call_mercury, thread_safe],
"
ML_Semaphore *sem;
@@ -142,7 +200,7 @@ init(Semaphore, !IO) :-
").
:- pragma foreign_proc("C#",
- init(Count::in) = (Semaphore::uo),
+ impure_init(Count::in, Semaphore::uo),
[will_not_call_mercury, thread_safe],
"
Semaphore = new thread__semaphore.ML_Semaphore();
@@ -150,7 +208,7 @@ init(Semaphore, !IO) :-
").
:- pragma foreign_proc("Java",
- init(Count::in) = (Semaphore::uo),
+ impure_init(Count::in, Semaphore::uo),
[will_not_call_mercury, thread_safe],
"
Semaphore = new jmercury.runtime.Semaphore(Count);
@@ -174,16 +232,18 @@ ML_finalize_semaphore(void *obj, void *cd)
}
").
- % semaphore.signal causes the calling context to resume in semaphore.nop,
+%-----------------------------------------------------------------------------%
+
+ % impure_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.impure_signal/1).
:- pragma foreign_proc("C",
- signal(Semaphore::in, _IO0::di, _IO::uo),
- [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+ impure_signal(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
ML_Semaphore *sem;
#ifndef MR_HIGHLEVEL_CODE
@@ -254,8 +314,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],
+ impure_signal(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
System.Threading.Monitor.Enter(Semaphore);
Semaphore.count++;
@@ -265,22 +325,24 @@ 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],
+ impure_signal(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
Semaphore.release();
").
- % semaphore.wait causes the calling context to resume in semaphore.nop,
+%-----------------------------------------------------------------------------%
+
+ % impure_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(impure_wait/1).
:- pragma foreign_proc("C",
- wait(Semaphore::in, _IO0::di, _IO::uo),
- [promise_pure, will_not_call_mercury, thread_safe, tabled_for_io],
+ impure_wait(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
ML_Semaphore *sem;
#ifndef MR_HIGHLEVEL_CODE
@@ -342,8 +404,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],
+ impure_wait(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
System.Threading.Monitor.Enter(Semaphore);
@@ -357,8 +419,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],
+ impure_wait(Semaphore::in),
+ [will_not_call_mercury, thread_safe],
"
/*
** acquire() might be useful as well; it will throw an exception if the
@@ -367,15 +429,17 @@ ML_finalize_semaphore(void *obj, void *cd)
Semaphore.acquireUninterruptibly();
").
-semaphore.try_wait(Sem, Res, !IO) :-
- try_wait_2(Sem, Res0, !IO),
+%-----------------------------------------------------------------------------%
+
+impure_try_wait(Sem, Res) :-
+ impure 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 impure_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],
+ impure_try_wait_2(Semaphore::in, Res::out),
+ [will_not_call_mercury, thread_safe],
"
ML_Semaphore *sem;
@@ -393,8 +457,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],
+ impure_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 +475,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],
+ impure_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