src/Pure/Concurrent/simple_thread.ML
author wenzelm
Sun, 09 Mar 2014 17:02:18 +0100
changeset 56003 eccac152ffb4
parent 53709 84522727f9d3
child 59054 61b723761dff
permissions -rw-r--r--
check fact names with PIDE markup;
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
49894
69bfd86cc711 more robust cancel_now: avoid shooting yourself in the foot;
wenzelm
parents: 44112
diff changeset
     9
  val is_self: Thread.thread -> bool
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    10
  val attributes: bool -> Thread.threadAttribute list
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    11
  val fork: bool -> (unit -> unit) -> Thread.thread
52583
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 49894
diff changeset
    12
  val join: Thread.thread -> unit
44112
ef876972fdc1 more explicit Simple_Thread.interrupt_unsynchronized, to emphasize its meaning;
wenzelm
parents: 40232
diff changeset
    13
  val interrupt_unsynchronized: Thread.thread -> unit
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    14
  val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    15
end;
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    16
37216
3165bc303f66 modernized some structure names, keeping a few legacy aliases;
wenzelm
parents: 33605
diff changeset
    17
structure Simple_Thread: SIMPLE_THREAD =
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    18
struct
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    19
49894
69bfd86cc711 more robust cancel_now: avoid shooting yourself in the foot;
wenzelm
parents: 44112
diff changeset
    20
fun is_self thread = Thread.equal (Thread.self (), thread);
69bfd86cc711 more robust cancel_now: avoid shooting yourself in the foot;
wenzelm
parents: 44112
diff changeset
    21
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    22
fun attributes interrupts =
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    23
  if interrupts then Multithreading.public_interrupts else Multithreading.no_interrupts;
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    24
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    25
fun fork interrupts body =
39232
69c6d3e87660 more abstract treatment of interrupts in structure Exn -- hardly ever need to mention Interrupt literally;
wenzelm
parents: 37216
diff changeset
    26
  Thread.fork (fn () =>
53709
84522727f9d3 improved printing of exception trace in Poly/ML 5.5.1;
wenzelm
parents: 53527
diff changeset
    27
    print_exception_trace General.exnMessage (fn () =>
53527
9b0af3298cda tuned comment;
wenzelm
parents: 52583
diff changeset
    28
      body () handle exn => if Exn.is_interrupt exn then () (*sic!*) else reraise exn),
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    29
    attributes interrupts);
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    30
52583
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 49894
diff changeset
    31
fun join thread =
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 49894
diff changeset
    32
  while Thread.isActive thread
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 49894
diff changeset
    33
  do OS.Process.sleep (seconds 0.1);
0a7240d88e09 explicit shutdown of message output thread;
wenzelm
parents: 49894
diff changeset
    34
44112
ef876972fdc1 more explicit Simple_Thread.interrupt_unsynchronized, to emphasize its meaning;
wenzelm
parents: 40232
diff changeset
    35
fun interrupt_unsynchronized thread = Thread.interrupt thread handle Thread _ => ();
28550
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    36
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    37
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    38
(* basic synchronization *)
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    39
33605
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    40
fun synchronized name lock e =
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    41
  if Multithreading.available then
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    42
    Exn.release (uninterruptible (fn restore_attributes => fn () =>
40232
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    43
      let
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    44
        val immediate =
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    45
          if Mutex.trylock lock then true
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    46
          else
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    47
            let
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    48
              val _ = Multithreading.tracing 5 (fn () => name ^ ": locking ...");
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    49
              val time = Multithreading.real_time Mutex.lock lock;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    50
              val _ = Multithreading.tracing_time true time
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    51
                (fn () => name ^ ": locked after " ^ Time.toString time);
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    52
            in false end;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    53
        val result = Exn.capture (restore_attributes e) ();
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    54
        val _ =
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    55
          if immediate then () else Multithreading.tracing 5 (fn () => name ^ ": unlocking ...");
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    56
        val _ = Mutex.unlock lock;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    57
      in result end) ())
33605
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    58
  else e ();
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    59
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    60
end;