src/Pure/Concurrent/simple_thread.ML
author haftmann
Mon, 20 Jul 2009 15:24:15 +0200
changeset 32082 90d03908b3d7
parent 32051 82a9875b8707
child 32184 cfa0ef0c0c5f
permissions -rw-r--r--
less digestible
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Concurrent/simple_thread.ML
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     3
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
     4
Simplified thread operations.
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     5
*)
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     6
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     7
signature SIMPLE_THREAD =
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     8
sig
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
     9
  val fork: bool -> (unit -> unit) -> Thread.thread
28550
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    10
  val interrupt: Thread.thread -> unit
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    11
  val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    12
end;
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    13
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    14
structure SimpleThread: SIMPLE_THREAD =
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    15
struct
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    16
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    17
fun fork interrupts body =
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    18
  Thread.fork (fn () => exception_trace (fn () => body ()),
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    19
    if interrupts then Multithreading.regular_interrupts else Multithreading.no_interrupts);
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    20
28550
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    21
fun interrupt thread = Thread.interrupt thread handle Thread _ => ();
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    22
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    23
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    24
(* basic synchronization *)
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    25
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    26
fun synchronized name lock e = Exn.release (uninterruptible (fn restore_attributes => fn () =>
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    27
  let
32051
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    28
    val immediate =
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    29
      if Mutex.trylock lock then true
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    30
      else
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    31
       (Multithreading.tracing 3 (fn () => name ^ ": locking ...");
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    32
        Mutex.lock lock;
32051
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    33
        Multithreading.tracing 3 (fn () => name ^ ": locked");
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    34
        false);
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    35
    val result = Exn.capture (restore_attributes e) ();
32051
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    36
    val _ =
82a9875b8707 synchronized: tuned tracing;
wenzelm
parents: 29564
diff changeset
    37
      if immediate then () else Multithreading.tracing 3 (fn () => name ^ ": unlocking ...");
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    38
    val _ = Mutex.unlock lock;
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    39
  in result end) ());
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    40
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    41
end;