more frugal single-assignment according to David Matthews: dispose mutable lock/cond eventually;
--- a/src/Pure/Concurrent/single_assignment.ML Wed Jul 04 14:26:27 2018 +0200
+++ b/src/Pure/Concurrent/single_assignment.ML Wed Jul 04 22:44:24 2018 +0200
@@ -16,40 +16,46 @@
structure Single_Assignment: SINGLE_ASSIGNMENT =
struct
-abstype 'a var = Var of
- {name: string,
- lock: Mutex.mutex,
- cond: ConditionVar.conditionVar,
- var: 'a SingleAssignment.saref}
+datatype 'a state =
+ Set of 'a
+ | Unset of {lock: Mutex.mutex, cond: ConditionVar.conditionVar};
+
+fun init_state () =
+ Unset {lock = Mutex.mutex (), cond = ConditionVar.conditionVar ()};
+
+abstype 'a var = Var of {name: string, state: 'a state Unsynchronized.ref}
with
-fun var name = Var
- {name = name,
- lock = Mutex.mutex (),
- cond = ConditionVar.conditionVar (),
- var = SingleAssignment.saref ()};
+fun var name = Var {name = name, state = Unsynchronized.ref (init_state ())};
+
+fun peek (Var {state, ...}) = (case ! state of Set x => SOME x | Unset _ => NONE);
-fun peek (Var {var, ...}) = SingleAssignment.savalue var;
+fun await (v as Var {name, state}) =
+ (case ! state of
+ Set x => x
+ | Unset {lock, cond} =>
+ Multithreading.synchronized name lock (fn () =>
+ let
+ fun wait () =
+ (case peek v of
+ NONE =>
+ (case Multithreading.sync_wait NONE cond lock of
+ Exn.Res _ => wait ()
+ | Exn.Exn exn => Exn.reraise exn)
+ | SOME x => x);
+ in wait () end));
-fun await (v as Var {name, lock, cond, ...}) =
- Multithreading.synchronized name lock (fn () =>
- let
- fun wait () =
+fun assign_fail name = raise Fail ("Duplicate assignment to " ^ name);
+fun assign (v as Var {name, state}) x =
+ (case ! state of
+ Set _ => assign_fail name
+ | Unset {lock, cond} =>
+ Multithreading.synchronized name lock (fn () =>
(case peek v of
- NONE =>
- (case Multithreading.sync_wait NONE cond lock of
- Exn.Res _ => wait ()
- | Exn.Exn exn => Exn.reraise exn)
- | SOME x => x);
- in wait () end);
-
-fun assign (v as Var {name, lock, cond, var}) x =
- Multithreading.synchronized name lock (fn () =>
- (case peek v of
- SOME _ => raise Fail ("Duplicate assignment to " ^ name)
- | NONE =>
- Thread_Attributes.uninterruptible (fn _ => fn () =>
- (SingleAssignment.saset (var, x); ConditionVar.broadcast cond)) ()));
+ SOME _ => assign_fail name
+ | NONE =>
+ Thread_Attributes.uninterruptible (fn _ => fn () =>
+ (state := Set x; RunCall.clearMutableBit state; ConditionVar.broadcast cond)) ())));
end;