%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-2003, 2006 The University of Melbourne.
% 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: philo2.m.
% Main author: petdr (based on code by conway)
%
% The classic "Dining Philosophers" problem, to show how to use mvars
% to do coroutining.
%
%-----------------------------------------------------------------------------%
%---------------------------------------------------------------------------%

:- module philo2.
:- interface.

:- import_module io.

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

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

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

:- implementation.

:- import_module mvar.
:- import_module spawn.

:- import_module bool.
:- import_module list.
:- import_module require.
:- import_module string.

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

:- type forks
    --->    forks(bool, bool, bool, bool, bool).

:- type philosopher
    --->    plato
    ;       aristotle
    ;       descartes
    ;       russell
    ;       sartre.

main(!IO) :-
    mvar.init(ForkGlob, !IO),
    mvar.put(ForkGlob, forks(yes, yes, yes, yes, yes), !IO),
    spawn(philosopher(plato, ForkGlob), !IO),
    spawn(philosopher(aristotle, ForkGlob), !IO),
    spawn(philosopher(descartes, ForkGlob), !IO),
    spawn(philosopher(russell, ForkGlob), !IO),
    philosopher(sartre, ForkGlob, !IO).

:- pred philosopher(philosopher::in, mvar(forks)::in, io::di, io::uo)
    is cc_multi.

philosopher(Who, ForkGlob, !IO) :-
    io.flush_output(!IO),
    name(Who, Name),
    io.format("%s is thinking.\n", [s(Name)], !IO),
    rand_sleep(5, !IO),
    mvar.take(ForkGlob, Forks0, !IO),
    io.format("%s is attempting to eat.\n", [s(Name)], !IO),
    ( forks(Who, Forks0, Forks1) ->
        mvar.put(ForkGlob, Forks1, !IO),
        io.format("%s is eating.\n", [s(Name)], !IO),
        rand_sleep(10, !IO),
        mvar.take(ForkGlob, Forks2, !IO),
        ( forks(Who, Forks3, Forks2) ->
            mvar.put(ForkGlob, Forks3, !IO)
        ;
            error("all forked up")
        )
    ;
        % Our 2 forks were not available
        mvar.put(ForkGlob, Forks0, !IO)
    ),
    philosopher(Who, ForkGlob, !IO).

:- pred forks(philosopher, forks, forks).
:- mode forks(in, in, out) is semidet.
:- mode forks(in, out, in) is semidet.

forks(plato,        forks(yes, yes, C, D, E), forks(no, no, C, D, E)).
forks(aristotle,    forks(A, yes, yes, D, E), forks(A, no, no, D, E)).
forks(descartes,    forks(A, B, yes, yes, E), forks(A, B, no, no, E)).
forks(russell,      forks(A, B, C, yes, yes), forks(A, B, C, no, no)).
forks(sartre,       forks(yes, B, C, D, yes), forks(no, B, C, D, no)).

:- pred name(philosopher::in, string::out) is det.

name(plato,     "Plato").
name(aristotle, "Aristotle").
name(descartes, "Descartes").
name(russell,   "Russell").
name(sartre,    "Sartre").

:- pragma foreign_code("C#", "
    public static System.Random rng = new System.Random();
").

:- pred rand_sleep(int::in, io::di, io::uo) is det.

:- pragma foreign_proc("C",
    rand_sleep(Int::in, IO0::di, IO::uo),
    [promise_pure, thread_safe, will_not_call_mercury],
"
#ifdef _MSC_VER
    Sleep(1000 * (rand() % Int));
#else
    sleep((rand() % Int));
#endif
    IO =  IO0;
").

:- pragma foreign_proc("C#",
    rand_sleep(Int::in, _IO0::di, _IO::uo),
    [promise_pure, thread_safe, will_not_call_mercury],
"
    System.Threading.Thread.Sleep(rng.Next(Int) * 1000);
").

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