src/Pure/Concurrent/mailbox.ML
author haftmann
Thu Oct 22 13:48:06 2009 +0200 (2009-10-22)
changeset 33063 4d462963a7db
parent 29564 f8b933a62151
child 52583 0a7240d88e09
permissions -rw-r--r--
map_range (and map_index) combinator
wenzelm@28135
     1
(*  Title:      Pure/Concurrent/mailbox.ML
wenzelm@28140
     2
    Author:     Makarius
wenzelm@28135
     3
wenzelm@28579
     4
Message exchange via mailbox, with non-blocking send (due to unbounded
wenzelm@28579
     5
queueing) and potentially blocking receive.
wenzelm@28135
     6
*)
wenzelm@28135
     7
wenzelm@28135
     8
signature MAILBOX =
wenzelm@28135
     9
sig
wenzelm@28135
    10
  type 'a T
wenzelm@28135
    11
  val create: unit -> 'a T
wenzelm@28170
    12
  val send: 'a T -> 'a -> unit
wenzelm@28579
    13
  val receive: 'a T -> 'a
wenzelm@28139
    14
  val receive_timeout: Time.time -> 'a T -> 'a option
wenzelm@28135
    15
end;
wenzelm@28135
    16
wenzelm@28135
    17
structure Mailbox: MAILBOX =
wenzelm@28135
    18
struct
wenzelm@28135
    19
wenzelm@28576
    20
datatype 'a T = Mailbox of 'a Queue.T Synchronized.var;
wenzelm@28579
    21
wenzelm@28576
    22
fun create () = Mailbox (Synchronized.var "mailbox" Queue.empty);
wenzelm@28135
    23
wenzelm@28579
    24
fun send (Mailbox mailbox) msg =
wenzelm@28579
    25
  Synchronized.change mailbox (Queue.enqueue msg);
wenzelm@28139
    26
wenzelm@28579
    27
fun receive (Mailbox mailbox) =
wenzelm@28579
    28
  Synchronized.guarded_access mailbox (try Queue.dequeue);
wenzelm@28579
    29
wenzelm@28576
    30
fun receive_timeout timeout (Mailbox mailbox) =
wenzelm@28579
    31
  Synchronized.timed_access mailbox
wenzelm@28579
    32
    (fn _ => SOME (Time.+ (Time.now (), timeout))) (try Queue.dequeue);
wenzelm@28135
    33
wenzelm@28135
    34
end;