src/Pure/Concurrent/single_assignment.ML
author wenzelm
Wed, 06 Sep 2023 20:51:28 +0200
changeset 78650 47d0c333d155
parent 70696 47ca5c7550e4
child 78720 909dc00766a0
permissions -rw-r--r--
clarified signature: retain original Poly/ML names Thread.Thread, Thread.Mutex, Thread.ConditionVar and de-emphasize them for Isabelle/ML;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
35014
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     1
(*  Title:      Pure/Concurrent/single_assignment.ML
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     2
    Author:     Makarius
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     3
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     4
Single-assignment variables with locking/signalling.
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     5
*)
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     6
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     7
signature SINGLE_ASSIGNMENT =
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     8
sig
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
     9
  type 'a var
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    10
  val var: string -> 'a var
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    11
  val peek: 'a var -> 'a option
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    12
  val await: 'a var -> 'a
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    13
  val assign: 'a var -> 'a -> unit
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    14
end;
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    15
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    16
structure Single_Assignment: SINGLE_ASSIGNMENT =
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    17
struct
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    18
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    19
datatype 'a state =
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    20
    Set of 'a
78650
47d0c333d155 clarified signature: retain original Poly/ML names Thread.Thread, Thread.Mutex, Thread.ConditionVar and de-emphasize them for Isabelle/ML;
wenzelm
parents: 70696
diff changeset
    21
  | Unset of {lock: Thread.Mutex.mutex, cond: Thread.ConditionVar.conditionVar};
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    22
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    23
fun init_state () =
78650
47d0c333d155 clarified signature: retain original Poly/ML names Thread.Thread, Thread.Mutex, Thread.ConditionVar and de-emphasize them for Isabelle/ML;
wenzelm
parents: 70696
diff changeset
    24
  Unset {lock = Thread.Mutex.mutex (), cond = Thread.ConditionVar.conditionVar ()};
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    25
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    26
abstype 'a var = Var of {name: string, state: 'a state Unsynchronized.ref}
35014
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    27
with
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    28
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    29
fun var name = Var {name = name, state = Unsynchronized.ref (init_state ())};
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    30
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    31
fun peek (Var {name, state}) =
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    32
  (case ! state of
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    33
    Set x => SOME x
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    34
  | Unset {lock, ...} =>
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    35
      Multithreading.synchronized name lock (fn () =>
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    36
        (case ! state of
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    37
          Set x => SOME x
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    38
        | Unset _ => NONE)));
35014
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    39
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    40
fun await (Var {name, state}) =
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    41
  (case ! state of
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    42
    Set x => x
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    43
  | Unset {lock, cond} =>
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    44
      Multithreading.synchronized name lock (fn () =>
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    45
        let
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    46
          fun wait () =
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    47
            (case ! state of
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    48
              Unset _ =>
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    49
                (case Multithreading.sync_wait NONE cond lock of
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    50
                  Exn.Res _ => wait ()
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    51
                | Exn.Exn exn => Exn.reraise exn)
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    52
            | Set x => x);
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    53
        in wait () end));
35014
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    54
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    55
fun assign_fail name = raise Fail ("Duplicate assignment to " ^ name);
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    56
fun assign (Var {name, state}) x =
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    57
  (case ! state of
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    58
    Set _ => assign_fail name
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    59
  | Unset {lock, cond} =>
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    60
      Multithreading.synchronized name lock (fn () =>
70696
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    61
        (case ! state of
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    62
          Set _ => assign_fail name
47ca5c7550e4 potentially more robust: read under lock if not yet set;
wenzelm
parents: 68589
diff changeset
    63
        | Unset _ =>
68589
9258f16d68b4 more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
wenzelm
parents: 67009
diff changeset
    64
            Thread_Attributes.uninterruptible (fn _ => fn () =>
78650
47d0c333d155 clarified signature: retain original Poly/ML names Thread.Thread, Thread.Mutex, Thread.ConditionVar and de-emphasize them for Isabelle/ML;
wenzelm
parents: 70696
diff changeset
    65
             (state := Set x; RunCall.clearMutableBit state;
47d0c333d155 clarified signature: retain original Poly/ML names Thread.Thread, Thread.Mutex, Thread.ConditionVar and de-emphasize them for Isabelle/ML;
wenzelm
parents: 70696
diff changeset
    66
               Thread.ConditionVar.broadcast cond)) ())));
35014
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    67
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    68
end;
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    69
a725ff6ead26 explicit representation of single-assignment variables;
wenzelm
parents:
diff changeset
    70
end;