[m-rev.] diff: start shifting concurrency examples into samples
Julien Fischer
juliensf at csse.unimelb.edu.au
Mon Nov 8 19:18:21 AEDT 2010
Branches: main
Shift the dining philosophers examples out of the extras distribution and into
the samples directory. (The latter location is more appropriate for them since
the concurrency support has been part of the standard library for a while.)
The remaining contents of extras/concurrency will be moved into samples/concurrency
in a separate change.
extras/concurrency/philo.m:
extras/concurrency/philo2.m:
extras/concurrency/philo3.m:
Shift these modules into samples/concurrency/dining_philosophers.
extras/concurrency/concurrency.m:
extras/concurrency/spawn.m:
Delete the top-level of the old concurrency module and the spawn
module.
extras/concurrency/Mercury.options:
extras/concurrency/Mmakefile:
Don't build libconcurrency.
Delete references to things that no longer exist or have been
moved.
Julien.
Index: extras/concurrency/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/Mercury.options,v
retrieving revision 1.2
diff -u -r1.2 Mercury.options
--- extras/concurrency/Mercury.options 1 Feb 2007 08:07:57 -0000 1.2
+++ extras/concurrency/Mercury.options 8 Nov 2010 08:12:15 -0000
@@ -1 +0,0 @@
-MCFLAGS-concurrency += --no-warn-nothing-exported --no-warn-interface-imports
Index: extras/concurrency/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/Mmakefile,v
retrieving revision 1.8
diff -u -r1.8 Mmakefile
--- extras/concurrency/Mmakefile 26 Sep 2006 03:54:43 -0000 1.8
+++ extras/concurrency/Mmakefile 8 Nov 2010 08:12:03 -0000
@@ -6,18 +6,18 @@
INSTALL_PREFIX := $(INSTALL_PREFIX)/extras
-TESTS = philo philo2 philo3 midimon
+TESTS = midimon
-include ../Mmake.params
include Mercury.options
default_target: all
-depend: concurrency.depend $(TESTS:%=%.depend)
-all: libconcurrency tests
-install: libconcurrency.install
-clean: concurrency.clean $(TESTS:%=%.clean)
-realclean: concurrency.realclean $(TESTS:%=%.realclean)
+depend: $(TESTS:%=%.depend)
+all: tests
+install:
+clean: $(TESTS:%=%.clean)
+realclean: $(TESTS:%=%.realclean)
tests: $(TESTS)
.PHONY: check
Index: extras/concurrency/concurrency.m
===================================================================
RCS file: extras/concurrency/concurrency.m
diff -N extras/concurrency/concurrency.m
--- extras/concurrency/concurrency.m 1 Feb 2007 08:07:57 -0000 1.3
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,20 +0,0 @@
-%---------------------------------------------------------------------------%
-% Copyright (C) 2002, 2006-2007 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.
-%---------------------------------------------------------------------------%
-
-:- module concurrency.
-:- interface.
-
- % The "concurrency" library package consists of the following modules.
- %
-:- import_module global.
-:- import_module spawn.
-:- import_module stream.
-
- % These modules have been moved to the standard library.
- %
-% :- import_module channel.
-% :- import_module mvar.
-% :- import_module semaphore.
Index: extras/concurrency/philo.m
===================================================================
RCS file: extras/concurrency/philo.m
diff -N extras/concurrency/philo.m
--- extras/concurrency/philo.m 3 Nov 2010 07:11:31 -0000 1.4
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,110 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2000, 2006-2007 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: philo.m.
-% Main author: conway.
-%
-% The classic "Dining Philosophers" problem, to show how to use the basic
-% coroutining primitives.
-%
-%-----------------------------------------------------------------------------%
-
-:- module philo.
-:- interface.
-
-:- import_module io.
-
-%-----------------------------------------------------------------------------%
-
-:- pred main(io::di, io::uo) is cc_multi.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module thread.
-:- import_module thread.semaphore.
-
-:- import_module bool.
-:- import_module list.
-:- import_module require.
-:- import_module string.
-
-%-----------------------------------------------------------------------------%
-
-:- mutable(fork_global, forks, forks(yes, yes, yes, yes, yes), ground,
- [untrailed, attach_to_io_state]).
-
-%-----------------------------------------------------------------------------%
-
-:- type forks
- ---> forks(bool, bool, bool, bool, bool).
-
-:- type philosopher
- ---> plato
- ; aristotle
- ; descartes
- ; russell
- ; sartre.
-
-main(!IO) :-
- semaphore.new(Lock, !IO),
- semaphore.signal(Lock, !IO),
- spawn(philosopher(plato, Lock), !IO),
- spawn(philosopher(aristotle, Lock), !IO),
- spawn(philosopher(descartes, Lock), !IO),
- spawn(philosopher(russell, Lock), !IO),
- philosopher(sartre, Lock, !IO).
-
-:- pred philosopher(philosopher::in, semaphore::in, io::di, io::uo) is cc_multi.
-
-philosopher(Who, Lock, !IO) :-
- name(Who, Name),
- io.format("%s is thinking.\n", [s(Name)], !IO),
- semaphore.wait(Lock, !IO),
- get_fork_global(Forks0, !IO),
- ( forks(Who, Forks0, Forks1) ->
- set_fork_global(Forks1, !IO),
- semaphore.signal(Lock, !IO),
- io.format("%s is eating.\n", [s(Name)], !IO),
- semaphore.wait(Lock, !IO),
- get_fork_global(Forks2, !IO),
- ( forks(Who, Forks3, Forks2) ->
- set_fork_global(Forks3, !IO),
- semaphore.signal(Lock, !IO)
- ;
- error("all forked up")
- )
- ;
- % Our 2 forks were not available
- signal(Lock, !IO)
- ),
- philosopher(Who, Lock, !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").
-
-%-----------------------------------------------------------------------------%
-:- end_module philo.
-%-----------------------------------------------------------------------------%
Index: extras/concurrency/philo2.m
===================================================================
RCS file: extras/concurrency/philo2.m
diff -N extras/concurrency/philo2.m
--- extras/concurrency/philo2.m 3 Nov 2010 07:11:31 -0000 1.10
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,154 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2000-2003, 2006-2007 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 thread.
-:- import_module thread.mvar.
-
-:- 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();
-").
-
-:- pragma foreign_decl("Java", "
-
-import java.util.Random;
-
-").
-
-:- pragma foreign_code("Java", "
- public static Random rng = new 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
-").
-
-:- 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);
-").
-
-:- pragma foreign_proc("Java",
- rand_sleep(Int::in, _IO0::di, _IO::uo),
- [promise_pure, thread_safe, will_not_call_mercury],
-"
- try {
- Thread.sleep(rng.nextInt(Int) * 1000);
- } catch ( InterruptedException e ) {
- /* Just return if we are interrupted.*/
- }
-").
-
-%---------------------------------------------------------------------------%
-:- end_module philo2.
-%---------------------------------------------------------------------------%
Index: extras/concurrency/philo3.m
===================================================================
RCS file: extras/concurrency/philo3.m
diff -N extras/concurrency/philo3.m
--- extras/concurrency/philo3.m 3 Nov 2010 07:11:31 -0000 1.7
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,129 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
-%-----------------------------------------------------------------------------%
-%
-% philo3.m
-% Copyright (C) 2001-2002 Ralph Becket <rbeck at microsoft.com>
-% Mon May 14 14:32:29 BST 2001
-%
-% RELEASED TO THE MERCURY PROJECT FOR DISTRIBUTION UNDER
-% WHATEVER LICENCE IS DEEMED APPROPRIATE BY THE PROJECT
-% MANAGEMENT.
-%
-% The dining philosophers using semaphores. The philosophers acquire forks
-% such that even numbered philosophers pick up left then right whereas odd
-% numbered philosophers pick up right then left. This is guaranteed not to
-% lead to deadlock.
-%
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- module philo3.
-:- interface.
-
-:- import_module io.
-
-:- pred main(io::di, io::uo) is cc_multi.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module thread.
-:- import_module thread.semaphore.
-
-:- import_module list.
-:- import_module string.
-
-%-----------------------------------------------------------------------------%
-
-main(!IO) :-
- semaphore.new(Fork0, !IO), semaphore.signal(Fork0, !IO),
- semaphore.new(Fork1, !IO), semaphore.signal(Fork1, !IO),
- semaphore.new(Fork2, !IO), semaphore.signal(Fork2, !IO),
- semaphore.new(Fork3, !IO), semaphore.signal(Fork3, !IO),
- semaphore.new(Fork4, !IO), semaphore.signal(Fork4, !IO),
- spawn(philosopher("Plato", 0, Fork0, 1, Fork1), !IO),
- spawn(philosopher("Aristotle", 2, Fork2, 1, Fork1), !IO),
- spawn(philosopher("Descartes", 2, Fork2, 3, Fork3), !IO),
- spawn(philosopher("Calvin", 4, Fork4, 3, Fork3), !IO),
- philosopher("Hobbes", 4, Fork4, 0, Fork0, !IO).
-
-%-----------------------------------------------------------------------------%
-
-:- pred philosopher(string::in, int::in, semaphore::in, int::in,
- semaphore::in, io::di, io::uo) is cc_multi.
-
-philosopher(Name, A, ForkA, B, ForkB, !IO) :-
-
- io.format("%s is thinking\n", [s(Name)], !IO),
- yield(!IO),
- rand_sleep(10, !IO),
-
- semaphore.wait(ForkA, !IO),
- io.format("%s has acquired fork %d\n", [s(Name), i(A)], !IO),
- semaphore.wait(ForkB, !IO),
- io.format("%s has acquired fork %d\n", [s(Name), i(B)], !IO),
-
- io.format("%s is eating\n", [s(Name)], !IO),
- yield(!IO),
- rand_sleep(5, !IO),
-
- io.format("%s relinquishes fork %d\n", [s(Name), i(B)], !IO),
- semaphore__signal(ForkB, !IO),
- io.format("%s relinquishes fork %d\n", [s(Name), i(A)], !IO),
- semaphore.signal(ForkA, !IO),
-
- philosopher(Name, A, ForkA, B, ForkB, !IO).
-
-%-----------------------------------------------------------------------------%
-
-:- pragma foreign_code("C#", "
- public static System.Random rng = new System.Random();
-").
-
-:- pragma foreign_decl("Java", "
-
-import java.util.Random;
-
-").
-
-:- pragma foreign_code("Java", "
- public static Random rng = new 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);
-").
-
-:- pragma foreign_proc("Java",
- rand_sleep(Int::in, _IO0::di, _IO::uo),
- [promise_pure, thread_safe, will_not_call_mercury],
-"
- try {
- Thread.sleep(rng.nextInt(Int) * 1000);
- } catch ( InterruptedException e ) {
- /* Just return if we are interrupted.*/
- }
-").
-
-%-----------------------------------------------------------------------------%
-:- end_module philo3.
-%-----------------------------------------------------------------------------%
Index: extras/concurrency/spawn.m
===================================================================
RCS file: extras/concurrency/spawn.m
diff -N extras/concurrency/spawn.m
--- extras/concurrency/spawn.m 19 Jan 2007 05:49:58 -0000 1.20
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,72 +0,0 @@
-%-----------------------------------------------------------------------------%
-% vim: ft=mercury ts=4 sw=4 et
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2000-2001,2003-2004, 2006-2007 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: spawn.m.
-% Main author: conway.
-% Stability: medium.
-%
-% This module provides `spawn/3' which is the primitive for starting the
-% concurrent execution of a goal. The term `concurrent' here is referring
-% to threads, not parallel execution, though the latter is possible by
-% compiling in one of the *.par grades (e.g. asm_fast.gc.par or hlc.gc.par).
-%
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- module spawn.
-:- interface.
-
-:- import_module io.
-
-%-----------------------------------------------------------------------------%
-
- % spawn(Closure, IO0, IO) is true iff IO0 denotes a list of I/O
- % transactions that is an interleaving of those performed by `Closure'
- % and those contained in IO - the list of transactions performed by
- % the continuation of spawn.
- %
- % NOTE: this predicate is obsolete. New code should use the
- % standard library's version: thread.spawn/3.
- %
-:- pragma obsolete(spawn.spawn/3).
-:- pred spawn(pred(io, io), io, io).
-:- mode spawn(pred(di, uo) is cc_multi, di, uo) is cc_multi.
-
- % yield(IO0, IO) is logically equivalent to (IO = IO0) but
- % operationally, yields the mercury engine to some other thread
- % if one exists.
- %
- % NOTE: this is not yet implemented in the hlc.par.gc grade.
- %
- % NOTE: this predicate is obsolete. New code should use the
- % standard library's version: thread.yield/2.
- %
-:- pragma obsolete(spawn.yield/2).
-:- pred yield(io::di, io::uo) is det.
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
-
-:- implementation.
-
-:- import_module thread.
-
-:- pragma foreign_decl("C", "
-#if defined(MR_HIGHLEVEL_CODE) && !defined(MR_THREAD_SAFE)
- #error The spawn module requires either hlc.par.gc grade or a non-hlc grade.
-#endif
-").
-
-spawn.spawn(Goal, !IO) :-
- thread.spawn(Goal, !IO).
-
-spawn.yield(!IO) :-
- thread.yield(!IO).
-
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
Index: samples/concurrency/dining_philosophers/philo.m
===================================================================
RCS file: samples/concurrency/dining_philosophers/philo.m
diff -N samples/concurrency/dining_philosophers/philo.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ samples/concurrency/dining_philosophers/philo.m 8 Nov 2010 08:08:10 -0000
@@ -0,0 +1,110 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000, 2006-2007 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: philo.m.
+% Main author: conway.
+%
+% The classic "Dining Philosophers" problem, to show how to use the basic
+% coroutining primitives.
+%
+%-----------------------------------------------------------------------------%
+
+:- module philo.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module thread.
+:- import_module thread.semaphore.
+
+:- import_module bool.
+:- import_module list.
+:- import_module require.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+:- mutable(fork_global, forks, forks(yes, yes, yes, yes, yes), ground,
+ [untrailed, attach_to_io_state]).
+
+%-----------------------------------------------------------------------------%
+
+:- type forks
+ ---> forks(bool, bool, bool, bool, bool).
+
+:- type philosopher
+ ---> plato
+ ; aristotle
+ ; descartes
+ ; russell
+ ; sartre.
+
+main(!IO) :-
+ semaphore.new(Lock, !IO),
+ semaphore.signal(Lock, !IO),
+ spawn(philosopher(plato, Lock), !IO),
+ spawn(philosopher(aristotle, Lock), !IO),
+ spawn(philosopher(descartes, Lock), !IO),
+ spawn(philosopher(russell, Lock), !IO),
+ philosopher(sartre, Lock, !IO).
+
+:- pred philosopher(philosopher::in, semaphore::in, io::di, io::uo) is cc_multi.
+
+philosopher(Who, Lock, !IO) :-
+ name(Who, Name),
+ io.format("%s is thinking.\n", [s(Name)], !IO),
+ semaphore.wait(Lock, !IO),
+ get_fork_global(Forks0, !IO),
+ ( forks(Who, Forks0, Forks1) ->
+ set_fork_global(Forks1, !IO),
+ semaphore.signal(Lock, !IO),
+ io.format("%s is eating.\n", [s(Name)], !IO),
+ semaphore.wait(Lock, !IO),
+ get_fork_global(Forks2, !IO),
+ ( forks(Who, Forks3, Forks2) ->
+ set_fork_global(Forks3, !IO),
+ semaphore.signal(Lock, !IO)
+ ;
+ error("all forked up")
+ )
+ ;
+ % Our 2 forks were not available
+ signal(Lock, !IO)
+ ),
+ philosopher(Who, Lock, !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").
+
+%-----------------------------------------------------------------------------%
+:- end_module philo.
+%-----------------------------------------------------------------------------%
Index: samples/concurrency/dining_philosophers/philo2.m
===================================================================
RCS file: samples/concurrency/dining_philosophers/philo2.m
diff -N samples/concurrency/dining_philosophers/philo2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ samples/concurrency/dining_philosophers/philo2.m 8 Nov 2010 08:08:10 -0000
@@ -0,0 +1,154 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000-2003, 2006-2007 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 thread.
+:- import_module thread.mvar.
+
+:- 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();
+").
+
+:- pragma foreign_decl("Java", "
+
+import java.util.Random;
+
+").
+
+:- pragma foreign_code("Java", "
+ public static Random rng = new 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
+").
+
+:- 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);
+").
+
+:- pragma foreign_proc("Java",
+ rand_sleep(Int::in, _IO0::di, _IO::uo),
+ [promise_pure, thread_safe, will_not_call_mercury],
+"
+ try {
+ Thread.sleep(rng.nextInt(Int) * 1000);
+ } catch ( InterruptedException e ) {
+ /* Just return if we are interrupted.*/
+ }
+").
+
+%---------------------------------------------------------------------------%
+:- end_module philo2.
+%---------------------------------------------------------------------------%
Index: samples/concurrency/dining_philosophers/philo3.m
===================================================================
RCS file: samples/concurrency/dining_philosophers/philo3.m
diff -N samples/concurrency/dining_philosophers/philo3.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ samples/concurrency/dining_philosophers/philo3.m 8 Nov 2010 08:08:10 -0000
@@ -0,0 +1,129 @@
+%-----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
+%-----------------------------------------------------------------------------%
+%
+% philo3.m
+% Copyright (C) 2001-2002 Ralph Becket <rbeck at microsoft.com>
+% Mon May 14 14:32:29 BST 2001
+%
+% RELEASED TO THE MERCURY PROJECT FOR DISTRIBUTION UNDER
+% WHATEVER LICENCE IS DEEMED APPROPRIATE BY THE PROJECT
+% MANAGEMENT.
+%
+% The dining philosophers using semaphores. The philosophers acquire forks
+% such that even numbered philosophers pick up left then right whereas odd
+% numbered philosophers pick up right then left. This is guaranteed not to
+% lead to deadlock.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module philo3.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module thread.
+:- import_module thread.semaphore.
+
+:- import_module list.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+main(!IO) :-
+ semaphore.new(Fork0, !IO), semaphore.signal(Fork0, !IO),
+ semaphore.new(Fork1, !IO), semaphore.signal(Fork1, !IO),
+ semaphore.new(Fork2, !IO), semaphore.signal(Fork2, !IO),
+ semaphore.new(Fork3, !IO), semaphore.signal(Fork3, !IO),
+ semaphore.new(Fork4, !IO), semaphore.signal(Fork4, !IO),
+ spawn(philosopher("Plato", 0, Fork0, 1, Fork1), !IO),
+ spawn(philosopher("Aristotle", 2, Fork2, 1, Fork1), !IO),
+ spawn(philosopher("Descartes", 2, Fork2, 3, Fork3), !IO),
+ spawn(philosopher("Calvin", 4, Fork4, 3, Fork3), !IO),
+ philosopher("Hobbes", 4, Fork4, 0, Fork0, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred philosopher(string::in, int::in, semaphore::in, int::in,
+ semaphore::in, io::di, io::uo) is cc_multi.
+
+philosopher(Name, A, ForkA, B, ForkB, !IO) :-
+
+ io.format("%s is thinking\n", [s(Name)], !IO),
+ yield(!IO),
+ rand_sleep(10, !IO),
+
+ semaphore.wait(ForkA, !IO),
+ io.format("%s has acquired fork %d\n", [s(Name), i(A)], !IO),
+ semaphore.wait(ForkB, !IO),
+ io.format("%s has acquired fork %d\n", [s(Name), i(B)], !IO),
+
+ io.format("%s is eating\n", [s(Name)], !IO),
+ yield(!IO),
+ rand_sleep(5, !IO),
+
+ io.format("%s relinquishes fork %d\n", [s(Name), i(B)], !IO),
+ semaphore__signal(ForkB, !IO),
+ io.format("%s relinquishes fork %d\n", [s(Name), i(A)], !IO),
+ semaphore.signal(ForkA, !IO),
+
+ philosopher(Name, A, ForkA, B, ForkB, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_code("C#", "
+ public static System.Random rng = new System.Random();
+").
+
+:- pragma foreign_decl("Java", "
+
+import java.util.Random;
+
+").
+
+:- pragma foreign_code("Java", "
+ public static Random rng = new 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);
+").
+
+:- pragma foreign_proc("Java",
+ rand_sleep(Int::in, _IO0::di, _IO::uo),
+ [promise_pure, thread_safe, will_not_call_mercury],
+"
+ try {
+ Thread.sleep(rng.nextInt(Int) * 1000);
+ } catch ( InterruptedException e ) {
+ /* Just return if we are interrupted.*/
+ }
+").
+
+%-----------------------------------------------------------------------------%
+:- end_module philo3.
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list