disallow concurrent execution attempt explicitly -- it should never happen due to management of singleton execution;
authorwenzelm
Thu, 11 Jul 2013 15:56:12 +0200
changeset 52598 cad097fb46de
parent 52597 a8a81453833d
child 52599 d7871f38ffb4
disallow concurrent execution attempt explicitly -- it should never happen due to management of singleton execution; tuned error messages: prefer plain "error" as in document.ML;
src/Pure/PIDE/command.ML
--- a/src/Pure/PIDE/command.ML	Thu Jul 11 14:56:58 2013 +0200
+++ b/src/Pure/PIDE/command.ML	Thu Jul 11 15:56:12 2013 +0200
@@ -45,13 +45,13 @@
 fun memo_result (Memo v) =
   (case Synchronized.value v of
     Result res => Exn.release res
-  | _ => raise Fail "Unfinished memo result");
+  | Expr (exec_id, _) => error ("Unfinished execution result: " ^ Document_ID.print exec_id));
 
 fun memo_exec (Memo v) =
   (case Synchronized.value v of
     Result res => res
-  | _ =>
-      Synchronized.guarded_access v
+  | Expr (exec_id, _) =>
+      Synchronized.timed_access v (fn _ => SOME Time.zeroTime)
         (fn Result res => SOME (res, Result res)
           | Expr (exec_id, e) =>
               uninterruptible (fn restore_attributes => fn () =>
@@ -62,7 +62,9 @@
                     if Exn.is_interrupt_exn res
                     then Exec.canceled exec_id
                     else Exec.finished exec_id;
-                in SOME (res, Result res) end) ()))
+                in SOME (res, Result res) end) ())
+      |> (fn NONE => error ("Concurrent execution attempt: " ^ Document_ID.print exec_id)
+           | SOME res => res))
   |> Exn.release;
 
 fun memo_fork params (Memo v) =