src/Pure/Concurrent/synchronized.ML
author wenzelm
Sat, 13 Dec 2008 15:00:39 +0100
changeset 29091 b81fe045e799
parent 28580 3f37ae257506
child 29564 f8b933a62151
permissions -rw-r--r--
Context.display_names;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Concurrent/synchronized.ML
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     3
    Author:     Fabian Immler and Makarius
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     4
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     5
State variables with synchronized access.
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     6
*)
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     7
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     8
signature SYNCHRONIZED =
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
     9
sig
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    10
  type 'a var
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    11
  val var: string -> 'a -> 'a var
28580
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    12
  val value: 'a var -> 'a
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    13
  val timed_access: 'a var -> ('a -> Time.time option) -> ('a -> ('b * 'a) option) -> 'b option
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    14
  val guarded_access: 'a var -> ('a -> ('b * 'a) option) -> 'b
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    15
  val change_result: 'a var -> ('a -> 'b * 'a) -> 'b
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    16
  val change: 'a var -> ('a -> 'a) -> unit
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    17
end;
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    18
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    19
structure Synchronized: SYNCHRONIZED =
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    20
struct
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    21
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    22
(* state variables *)
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    23
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    24
datatype 'a var = Var of
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    25
 {name: string,
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    26
  lock: Mutex.mutex,
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    27
  cond: ConditionVar.conditionVar,
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    28
  var: 'a ref};
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    29
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    30
fun var name x = Var
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    31
 {name = name,
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    32
  lock = Mutex.mutex (),
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    33
  cond = ConditionVar.conditionVar (),
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    34
  var = ref x};
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    35
28580
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    36
fun value (Var {name, lock, cond, var}) = SimpleThread.synchronized name lock (fn () => ! var);
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    37
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    38
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    39
(* synchronized access *)
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    40
28580
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    41
fun timed_access (Var {name, lock, cond, var}) time_limit f =
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    42
  SimpleThread.synchronized name lock (fn () =>
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    43
    let
28580
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    44
      fun try_change () =
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    45
        let val x = ! var in
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    46
          (case f x of
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    47
            SOME (y, x') => (var := x'; SOME y)
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    48
          | NONE =>
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    49
              (case time_limit x of
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    50
                NONE => (ConditionVar.wait (cond, lock); try_change ())
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    51
              | SOME t =>
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    52
                  if ConditionVar.waitUntil (cond, lock, t) then try_change ()
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    53
                  else NONE))
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    54
        end;
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    55
      val res = try_change ();
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    56
      val _ = ConditionVar.broadcast cond;
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    57
    in res end);
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    58
28580
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    59
fun guarded_access var f = the (timed_access var (K NONE) f);
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    60
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    61
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    62
(* unconditional change *)
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    63
3f37ae257506 added value;
wenzelm
parents: 28578
diff changeset
    64
fun change_result var f = guarded_access var (SOME o f);
28578
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    65
fun change var f = change_result var (fn x => ((), f x));
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    66
c7f2a0899679 State variables with synchronized access.
wenzelm
parents:
diff changeset
    67
end;