[m-rev.] for review: Add barriers (for concurrency) to the standard library

[Sebastian Godelet]

On 08.04.2014 17:52, Julien Fischer wrote:
>
> Hi Paul,
>
> On Tue, 8 Apr 2014, Paul Bone wrote:
>
>> On Thu, Apr 03, 2014 at 05:10:04PM +1100, Paul Bone wrote:
>>> For review by anyone
>>
>> Hi.
>>
>> This is waiting for a review, thanks.
>
> I'll take a look at it, but probably not until Thursday at the earliest.
Hi,

I've written (and attached) a simple test program to experiment with the 
library,
unfortunately I'm not sure how to integrate a new unit test in the compiler,
but maybe you'd have a quick look and see the barrier code in action (to 
safe some effort),

Greetings,

Sebastian.
>
> Cheers,
> Julien.
> _______________________________________________
> reviews mailing list
> reviews at lists.mercurylang.org
> https://www.mercurylang.org/lists/listinfo/reviews

-------------- next part --------------
%------------------------------------------------------------------------------%
% File: test_thread_barrier.m
% Main author: Sebastian Godelet <sebastian.godelet+github at gmail.com>
% Created on: Tue Apr  8 15:54:57 CEST 2014
% vim: ft=mercury ff=unix ts=4 sw=4 et
%
%------------------------------------------------------------------------------%

:- module test_thread_barrier.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is cc_multi.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- implementation.

%------------------------------------------------------------------------------%

:- import_module thread.
:- import_module thread.barrier.
:- import_module string, list, int, integer, require.

:- func fib(integer) = integer.

fib(N) = Fib :-
    ( N < integer(2) -> Fib = integer(1)
    ; Fib = fib(N-integer(1)) + fib(N-integer(2))
    ).

:- pred test_spawn_and_wait(int::in, io::di, io::uo) is cc_multi.

test_spawn_and_wait(ThreadCount, !IO) :-
    io.format("-- testing spawning with %d threads\n", [i(ThreadCount)], !IO),
    barrier.init(ThreadCount + 1, Barrier, !IO),
    list.foldl((pred(Thread::in, !.IO::di, !:IO::uo) is cc_multi :-
        io.format("spawning thread #%d\n", [i(Thread)], !IO),
        Entry = (pred(!.ThreadIO::di, !:ThreadIO::uo) is cc_multi :-
            N = 5 + Thread * 5,
            io.format("fib(%d) = %s\n",
                [i(N), s(integer.to_string(fib(integer(N))))], !ThreadIO),
            barrier.barrier(Barrier, !ThreadIO)
        ),
        spawn(Entry, !IO)
    ), 1 `..` ThreadCount, !IO),
    barrier.barrier(Barrier, !IO),
    io.print("-- test finished\n\n", !IO).

:- pred test_release(int::in, int::in, io::di, io::uo) is cc_multi.

test_release(AbortAt, ThreadCount, !IO) :-
    io.format("-- testing barrier release at %d of %d\n",
        [i(AbortAt), i(ThreadCount)], !IO),
    barrier.init(ThreadCount + 1, Barrier, !IO),
    list.foldl((pred(Thread::in, !.IO::di, !:IO::uo) is cc_multi :-
        io.format("spawning thread #%d\n", [i(Thread)], !IO),
        Entry = (pred(!.ThreadIO::di, !:ThreadIO::uo) is cc_multi :-
            N = 5 + Thread * 5,
            io.format("fib(%d) = %s\n",
                [i(N), s(integer.to_string(fib(integer(N))))], !ThreadIO),
            (   Thread = AbortAt ->
                io.format("releasing barrier at %d of %d\n",
                    [i(AbortAt), i(ThreadCount)], !ThreadIO),
                barrier.release_barrier(Barrier, !ThreadIO)
            ;
                barrier.barrier(Barrier, !ThreadIO)
            )
        ),
        spawn(Entry, !IO)
    ), 1 `..` ThreadCount, !IO),
    barrier.barrier(Barrier, !IO),
    io.print("-- test finished\n\n", !IO).

main(!IO) :-
    (   thread.can_spawn ->
        test_spawn_and_wait(5, !IO),
        test_release(3, 5, !IO)
    ;   unexpected($file, $pred, $grade ++ " does not support thread spawning")
    ).

%------------------------------------------------------------------------------%
% -*- Mode: Mercury; column: 80; indent-tabs-mode: nil; tabs-width: 4 -*-
%------------------------------------------------------------------------------%