src/Pure/Concurrent/simple_thread.ML
author nipkow
Tue, 14 Sep 2010 08:40:22 +0200
changeset 39314 aecb239a2bbc
parent 39232 69c6d3e87660
child 40232 7ed03c0ae420
permissions -rw-r--r--
removed duplicate lemma
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
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
     9
  val attributes: bool -> Thread.threadAttribute list
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    10
  val fork: bool -> (unit -> unit) -> Thread.thread
28550
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    11
  val interrupt: Thread.thread -> unit
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    12
  val synchronized: string -> Mutex.mutex -> (unit -> 'a) -> 'a
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    13
end;
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    14
37216
3165bc303f66 modernized some structure names, keeping a few legacy aliases;
wenzelm
parents: 33605
diff changeset
    15
structure Simple_Thread: SIMPLE_THREAD =
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    16
struct
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    17
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    18
fun attributes interrupts =
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    19
  if interrupts then Multithreading.public_interrupts else Multithreading.no_interrupts;
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    20
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    21
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
    22
  Thread.fork (fn () =>
69c6d3e87660 more abstract treatment of interrupts in structure Exn -- hardly ever need to mention Interrupt literally;
wenzelm
parents: 37216
diff changeset
    23
    exception_trace (fn () =>
69c6d3e87660 more abstract treatment of interrupts in structure Exn -- hardly ever need to mention Interrupt literally;
wenzelm
parents: 37216
diff changeset
    24
      body () handle exn => if Exn.is_interrupt exn then () else reraise exn),
33602
d25e6bd6ca95 exported SimpleThread.attributes;
wenzelm
parents: 33220
diff changeset
    25
    attributes interrupts);
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    26
28550
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    27
fun interrupt thread = Thread.interrupt thread handle Thread _ => ();
422e9bd169ac added fail-safe interrupt;
wenzelm
parents: 28241
diff changeset
    28
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    29
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    30
(* basic synchronization *)
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    31
33605
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    32
fun synchronized name lock e =
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    33
  if Multithreading.available then
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    34
    Exn.release (uninterruptible (fn restore_attributes => fn () =>
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    35
    let
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    36
      val immediate =
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    37
        if Mutex.trylock lock then true
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    38
        else
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    39
          let
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    40
            val _ = Multithreading.tracing 5 (fn () => name ^ ": locking ...");
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    41
            val time = Multithreading.real_time Mutex.lock lock;
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    42
            val _ = Multithreading.tracing_time true time
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    43
              (fn () => name ^ ": locked after " ^ Time.toString time);
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    44
          in false end;
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    45
      val result = Exn.capture (restore_attributes e) ();
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    46
      val _ =
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    47
        if immediate then () else Multithreading.tracing 5 (fn () => name ^ ": unlocking ...");
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    48
      val _ = Mutex.unlock lock;
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    49
    in result end) ())
f91ec14e20b6 admit dummy implementation;
wenzelm
parents: 33602
diff changeset
    50
  else e ();
28577
bd2456e0d944 added generic combinator for synchronized evaluation (formerly in future.ML);
wenzelm
parents: 28550
diff changeset
    51
28241
de20fccf6509 Simplified thread fork interface.
wenzelm
parents:
diff changeset
    52
end;