src/Pure/Concurrent/simple_thread.ML
author bulwahn
Thu, 07 Jul 2011 23:33:14 +0200
changeset 43704 47b0be18ccbe
parent 40232 7ed03c0ae420
child 44112 ef876972fdc1
permissions -rw-r--r--
floor and ceiling definitions are not code equations -- this enables trivial evaluation of floor and ceiling
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 () =>
40232
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    35
      let
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    36
        val immediate =
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    37
          if Mutex.trylock lock then true
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    38
          else
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    39
            let
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    40
              val _ = Multithreading.tracing 5 (fn () => name ^ ": locking ...");
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    41
              val time = Multithreading.real_time Mutex.lock lock;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    42
              val _ = Multithreading.tracing_time true time
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    43
                (fn () => name ^ ": locked after " ^ Time.toString time);
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    44
            in false end;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    45
        val result = Exn.capture (restore_attributes e) ();
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    46
        val _ =
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    47
          if immediate then () else Multithreading.tracing 5 (fn () => name ^ ": unlocking ...");
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    48
        val _ = Mutex.unlock lock;
7ed03c0ae420 tuned white-space;
wenzelm
parents: 39232
diff changeset
    49
      in result end) ())
33605
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;