mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 17:33:38 +00:00
Code Issues Projects Releases Wiki Activity

Update concurrency samples.

Browse Source 
samples/concurrency/midimon/concurrent_stream.m:
     Conform to the current version of the standard library.

samples/concurrency/midimon/midi.m:
samples/concurrency/midimon/midimon.m:
samples/concurrency/dining_philosophers/philo.m:
samples/concurrency/dining_philosophers/philo2.m:
samples/concurrency/dining_philosophers/philo3.m:
     Syntax and formatting fixes.
This commit is contained in:
Julien Fischer
2016-10-02 23:26:02 +11:00
parent 1fc495c33c
commit d29581dfb4
6 changed files with 49 additions and 50 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
samples/concurrency/dining_philosophers/philo.m
View File

@@ -70,20 +70,20 @@ 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) ->
get_fork_global(Forks0, !IO),
( if forks(Who, Forks0, Forks1) then
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) ->
( if forks(Who, Forks3, Forks2) then
set_fork_global(Forks3, !IO),
semaphore.signal(Lock, !IO)
;
else
error("all forked up")
)
;
else
% Our 2 forks were not available
signal(Lock, !IO)
),

8
samples/concurrency/dining_philosophers/philo2.m
View File

@@ -70,17 +70,17 @@ philosopher(Who, ForkGlob, !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) ->
( if forks(Who, Forks0, Forks1) then
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) ->
( if forks(Who, Forks3, Forks2) then
mvar.put(ForkGlob, Forks3, !IO)
;
else
error("all forked up")
)
;
else
% Our 2 forks were not available
mvar.put(ForkGlob, Forks0, !IO)
),

13
samples/concurrency/dining_philosophers/philo3.m
View File

@@ -1,7 +1,6 @@
%-----------------------------------------------------------------------------%
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix ft=mercury
%-----------------------------------------------------------------------------%
%
% philo3.m
% Copyright (C) 2001-2002 Ralph Becket <rbeck@microsoft.com>
% Mon May 14 14:32:29 BST 2001
@@ -82,7 +81,7 @@ philosopher(Name, A, ForkA, B, ForkB, !IO) :-
%-----------------------------------------------------------------------------%
:- pragma foreign_code("C#", "
public static System.Random rng = new System.Random();
public static System.Random rng = new System.Random();
").
:- pragma foreign_decl("Java", "
@@ -98,20 +97,20 @@ import java.util.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],
[promise_pure, thread_safe, will_not_call_mercury],
"
#if defined(MR_WIN32)
Sleep(1000 * (rand() % Int));
Sleep(1000 * (rand() % Int));
#else
sleep((rand() % Int));
sleep((rand() % Int));
#endif
").
:- pragma foreign_proc("C#",
rand_sleep(Int::in, _IO0::di, _IO::uo),
[promise_pure, thread_safe, will_not_call_mercury],
[promise_pure, thread_safe, will_not_call_mercury],
"
System.Threading.Thread.Sleep(rng.Next(Int) * 1000);
System.Threading.Thread.Sleep(rng.Next(Int) * 1000);
").
:- pragma foreign_proc("Java",

14
samples/concurrency/midimon/concurrent_stream.m
View File

@@ -83,16 +83,16 @@
new(Stream, !IO) :-
queue.init(Queue),
store.new_mutvar(Queue, QueueRef, !IO),
semaphore.new(Lock, !IO),
semaphore.init(Lock, !IO),
semaphore.signal(Lock, !IO),
semaphore.new(Semaphore, !IO),
semaphore.init(Semaphore, !IO),
Stream = concurrent_stream(Lock, QueueRef, Semaphore).
put(Stream, Thing, !IO) :-
Stream = concurrent_stream(Lock, QueueRef, Semaphore),
wait(Lock, !IO),
store.get_mutvar(QueueRef, Queue0, !IO),
queue.put(Queue0, ok(Thing), Queue),
queue.put(ok(Thing), Queue0, Queue),
store.set_mutvar(QueueRef, Queue, !IO),
signal(Lock, !IO),
signal(Semaphore, !IO).
@@ -101,7 +101,7 @@ end(Stream, !IO) :-
Stream = concurrent_stream(Lock, QueueRef, Semaphore),
semaphore.wait(Lock, !IO),
store.get_mutvar(QueueRef, Queue0, !IO),
queue.put(Queue0, end, Queue),
queue.put(end, Queue0, Queue),
store.set_mutvar(QueueRef, Queue, !IO),
semaphore.signal(Lock, !IO),
semaphore.signal(Semaphore, !IO).
@@ -110,7 +110,7 @@ error(Stream, Msg, !IO) :-
Stream = concurrent_stream(Lock, QueueRef, Semaphore),
semaphore.wait(Lock, !IO),
store.get_mutvar(QueueRef, Queue0, !IO),
queue.put(Queue0, error(Msg), Queue),
queue.put(error(Msg), Queue0, Queue),
store.set_mutvar(QueueRef, Queue, !IO),
semaphore.signal(Lock, !IO),
semaphore.signal(Semaphore, !IO).
@@ -120,10 +120,10 @@ get(Stream, Thing, !IO) :-
semaphore.wait(Semaphore, !IO),
semaphore.wait(Lock, !IO),
store.get_mutvar(QueueRef, Queue0, !IO),
( queue.get(Queue0, Thing0, Queue) ->
( if queue.get(Thing0, Queue0, Queue) then
Thing = Thing0,
store.set_mutvar(QueueRef, Queue, !IO)
;
else
error("concurrent_stream.get/4: queue and semaphore out of sync")
),
semaphore.signal(Lock, !IO).

52
samples/concurrency/midimon/midi.m
View File

@@ -101,7 +101,7 @@
%-----------------------------------------------------------------------------%
:- type hex
---> x0
---> x0
; x1
; x2
; x3
@@ -322,7 +322,7 @@ byte1a(x8, _LSN, _Status, _Ins, Outs, !IO) :-
error(Outs, "unexpected status byte", !IO).
byte1a(x9, _LSN, _Status, _Ins, Outs, !IO) :-
error(Outs, "unexpected status byte", !IO).
byte1a(xA, _LSN, _Status, _Ins, Outs, !IO) :-
byte1a(xA, _LSN, _Status, _Ins, Outs, !IO) :-
error(Outs, "unexpected status byte", !IO).
byte1a(xB, _LSN, _Status, _Ins, Outs, !IO) :-
error(Outs, "unexpected status byte", !IO).
@@ -509,7 +509,7 @@ byte2b(status(two(Kind), Chan), Byte1, Byte2, Ins, Outs, !IO) :-
Msg = kp(Chan, Byte1, Byte2)
;
Kind = cc,
(
( if
(
Byte1 = 122,
OnOrOff = ( Byte2 = 0 -> off ; on ),
@@ -530,9 +530,9 @@ byte2b(status(two(Kind), Chan), Byte1, Byte2, Ins, Outs, !IO) :-
Byte1 = 127,
Msg0 = mm(Chan, poly)
)
->
then
Msg = Msg0
;
else
Msg = cc(Chan, Byte1, Byte2)
)
;
@@ -562,14 +562,14 @@ sysex1(Bytes0, Status, Ins, Outs, !IO) :-
error(Outs, Err, !IO)
;
Res0 = ok(Byte),
( Byte >= 0, Byte =< 127 ->
( if Byte >= 0, Byte =< 127 then
sysex1([Byte|Bytes0], Status, Ins, Outs, !IO)
;
else
list.reverse(Bytes0, Bytes),
put(Outs, sys(sysex(Bytes)), !IO),
( Byte = 0xF7 ->
( if Byte = 0xF7 then
byte0(Status, Ins, Outs, !IO)
;
else
byte2hex(Byte, MSN, LSN),
byte0a(MSN, LSN, Status, Ins, Outs, !IO)
)
@@ -750,19 +750,19 @@ write_midi(rt(reset), Status, Ins, Outs, !IO) :-
io::di, io::uo) is det.
write_one(Status0, Status1, Byte1, Ins, Outs, !IO) :-
( Status0 = Status1 ->
( if Status0 = Status1 then
Status = Status0
;
else
Status = Status1,
( status(Status, Byte) ->
( if status(Status, Byte) then
put(Outs, Byte, !IO)
;
else
error(Outs, "invalid channel", !IO)
)
),
( Byte1 >= 0, Byte1 =< 127 ->
( if Byte1 >= 0, Byte1 =< 127 then
put(Outs, Byte1, !IO)
;
else
error(Outs, "invalid data byte", !IO)
),
write_midi(Status, Ins, Outs, !IO).
@@ -772,24 +772,24 @@ write_one(Status0, Status1, Byte1, Ins, Outs, !IO) :-
concurrent_stream(byte)::in, io::di, io::uo) is det.
write_two(Status0, Status1, Byte1, Byte2, Ins, Outs, !IO) :-
( Status0 = Status1 ->
( if Status0 = Status1 then
Status = Status0
;
else
Status = Status1,
( status(Status, Byte) ->
( if status(Status, Byte) then
put(Outs, Byte, !IO)
;
else
error(Outs, "invalid channel", !IO)
)
),
( Byte1 >= 0, Byte1 =< 127 ->
( if Byte1 >= 0, Byte1 =< 127 then
put(Outs, Byte1, !IO)
;
else
error(Outs, "invalid data byte", !IO)
),
( Byte2 >= 0, Byte2 =< 127 ->
( if Byte2 >= 0, Byte2 =< 127 then
put(Outs, Byte2, !IO)
;
else
error(Outs, "invalid data byte", !IO)
),
write_midi(Status, Ins, Outs, !IO).
@@ -816,13 +816,13 @@ status(status(Kind, Chan), Byte) :-
:- pred byte2hex(int::in, hex::out, hex::out) is det.
byte2hex(Byte, MSN, LSN) :-
(
( if
nibble2hex(Byte /\ 0xF, LSN0),
nibble2hex((Byte >> 4) /\ 0xF, MSN0)
->
then
LSN = LSN0,
MSN = MSN0
;
else
error("byte2hex: conversion failed!")
).

2
samples/concurrency/midimon/midimon.m
View File

@@ -130,7 +130,7 @@ print_messages(Stream, !IO) :-
io.write_string(".\n", !IO),
print_messages(Stream, !IO)
;
Res0 = end
Res0 = end
;
Res0 = error(Msg),
io.write_string(Msg, !IO),