src/Pure/Concurrent/mailbox.ML
author wenzelm
Sat, 13 Dec 2008 15:00:39 +0100
changeset 29091 b81fe045e799
parent 28579 0c50f8977971
child 29564 f8b933a62151
permissions -rw-r--r--
Context.display_names;
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
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
28140
a74a1c580360 proper header;
wenzelm
parents: 28139
diff changeset
     3
    Author:     Makarius
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     4
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
     5
Message exchange via mailbox, with non-blocking send (due to unbounded
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
     6
queueing) and potentially blocking receive.
28135
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
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
     9
signature MAILBOX =
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    10
sig
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    11
  type 'a T
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    12
  val create: unit -> 'a T
28170
a18cf8a0e656 tuned Mailbox.send;
wenzelm
parents: 28158
diff changeset
    13
  val send: 'a T -> 'a -> unit
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    14
  val receive: 'a T -> 'a
28139
831e545c655e added receive_timeout;
wenzelm
parents: 28135
diff changeset
    15
  val receive_timeout: Time.time -> 'a T -> 'a option
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    16
end;
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    17
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    18
structure Mailbox: MAILBOX =
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    19
struct
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    20
28576
dc4aae271c41 simplified implementation using Synchronized.var;
wenzelm
parents: 28443
diff changeset
    21
datatype 'a T = Mailbox of 'a Queue.T Synchronized.var;
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    22
28576
dc4aae271c41 simplified implementation using Synchronized.var;
wenzelm
parents: 28443
diff changeset
    23
fun create () = Mailbox (Synchronized.var "mailbox" Queue.empty);
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    24
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    25
fun send (Mailbox mailbox) msg =
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    26
  Synchronized.change mailbox (Queue.enqueue msg);
28139
831e545c655e added receive_timeout;
wenzelm
parents: 28135
diff changeset
    27
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    28
fun receive (Mailbox mailbox) =
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    29
  Synchronized.guarded_access mailbox (try Queue.dequeue);
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    30
28576
dc4aae271c41 simplified implementation using Synchronized.var;
wenzelm
parents: 28443
diff changeset
    31
fun receive_timeout timeout (Mailbox mailbox) =
28579
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    32
  Synchronized.timed_access mailbox
0c50f8977971 simplified synchronized variable access;
wenzelm
parents: 28576
diff changeset
    33
    (fn _ => SOME (Time.+ (Time.now (), timeout))) (try Queue.dequeue);
28135
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    34
4f6f0496e93c Concurrent message exchange via mailbox -- with unbounded queueing.
wenzelm
parents:
diff changeset
    35
end;