src/Pure/Concurrent/single_assignment.ML
changeset 68589 9258f16d68b4
parent 67009 b68592732783
child 70696 47ca5c7550e4
--- 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;