src/Pure/Concurrent/mailbox.ML
author wenzelm
Sat, 02 Apr 2016 23:29:05 +0200
changeset 62826 eb94e570c1a4
parent 57417 29fe9bac501b
permissions -rw-r--r--
prefer infix operations;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Concurrent/mailbox.ML
28140
a74a1c580360 proper header;
wenzelm
parents: 28139
diff changeset
     2
    Author:     Makarius
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     3
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
     4
Message exchange via mailbox, with multiple senders (non-blocking,
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
     5
unbounded buffering) and single receiver (bulk messages).
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     6
*)
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     7
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     8
signature MAILBOX =
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     9
sig
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    10
  type 'a T
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    11
  val create: unit -> 'a T
28170
a18cf8a0e656 tuned Mailbox.send;
wenzelm
parents: 28158
diff changeset
    12
  val send: 'a T -> 'a -> unit
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    13
  val receive: Time.time option -> 'a T -> 'a list
52583
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 29564
diff changeset
    14
  val await_empty: 'a T -> unit
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    15
end;
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    16
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    17
structure Mailbox: MAILBOX =
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    18
struct
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    19
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    20
datatype 'a T = Mailbox of 'a list Synchronized.var;
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    21
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    22
fun create () = Mailbox (Synchronized.var "mailbox" []);
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    23
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    24
fun send (Mailbox mailbox) msg = Synchronized.change mailbox (cons msg);
28139
831e545c655e added receive_timeout;
wenzelm
parents: 28135
diff changeset
    25
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    26
fun receive timeout (Mailbox mailbox) =
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    27
  Synchronized.timed_access mailbox
62826
eb94e570c1a4 prefer infix operations;
wenzelm
parents: 57417
diff changeset
    28
    (fn _ => Option.map (fn t => Time.now () + t) timeout)
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    29
    (fn [] => NONE | msgs => SOME (msgs, []))
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    30
  |> these |> rev;
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    31
52583
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 29564
diff changeset
    32
fun await_empty (Mailbox mailbox) =
57417
29fe9bac501b more tight Mailbox: single list is sufficient for single receiver, reverse outside critical section;
wenzelm
parents: 52583
diff changeset
    33
  Synchronized.guarded_access mailbox (fn [] => SOME ((), []) | _ => NONE);
52583
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 29564
diff changeset
    34
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    35
end;