no fork from draft thy -- avoid potential for crash via classrel_proof/arity_proof;
authorwenzelm
Mon, 07 Jan 2013 21:49:59 +0100
changeset 50763 e33921360f06
parent 50762 7d89bb992f48
child 50764 2bbc7ae80634
no fork from draft thy -- avoid potential for crash via classrel_proof/arity_proof;
src/Pure/proofterm.ML
--- a/src/Pure/proofterm.ML	Mon Jan 07 19:47:46 2013 +0100
+++ b/src/Pure/proofterm.ML	Mon Jan 07 21:49:59 2013 +0100
@@ -1401,12 +1401,16 @@
 
 fun fulfill_proof_future _ [] postproc body = Future.map postproc body
   | fulfill_proof_future thy promises postproc body =
-      (singleton o Future.forks)
-        {name = "Proofterm.fulfill_proof_future", group = NONE,
-          deps = Future.task_of body :: map (Future.task_of o snd) promises, pri = 0,
-          interrupts = true}
-        (fn () =>
-          postproc (fulfill_norm_proof thy (map (apsnd Future.join) promises) (Future.join body)));
+      if Context.is_draft thy then
+        Future.value
+          (postproc (fulfill_norm_proof thy (map (apsnd Future.join) promises) (Future.join body)))
+      else
+        (singleton o Future.forks)
+          {name = "Proofterm.fulfill_proof_future", group = NONE,
+            deps = Future.task_of body :: map (Future.task_of o snd) promises, pri = 0,
+            interrupts = true}
+          (fn () =>
+            postproc (fulfill_norm_proof thy (map (apsnd Future.join) promises) (Future.join body)));
 
 
 (***** abstraction over sort constraints *****)
@@ -1458,6 +1462,7 @@
     fun make_body0 proof0 = PBody {oracles = oracles0, thms = thms0, proof = proof0};
     val body0 =
       if not (proofs_enabled ()) then Future.value (make_body0 MinProof)
+      else if Context.is_draft thy then Future.value (make_body0 (full_proof0 ()))
       else
         (singleton o Future.cond_forks)
           {name = "Proofterm.prepare_thm_proof", group = NONE,