added Future.joins convenience;
authorwenzelm
Sat, 20 Aug 2011 15:52:29 +0200
changeset 44330 b28e091f683a
parent 44329 6325ea1c5dfd
child 44331 aa9c1e9ef2ce
added Future.joins convenience; clarified Future.map: based on Future.cond_forks;
src/Pure/Concurrent/future.ML
src/Pure/PIDE/document.ML
src/Pure/proofterm.ML
src/Pure/thm.ML
--- a/src/Pure/Concurrent/future.ML	Sat Aug 20 09:42:34 2011 +0200
+++ b/src/Pure/Concurrent/future.ML	Sat Aug 20 15:52:29 2011 +0200
@@ -62,12 +62,13 @@
   val fork: (unit -> 'a) -> 'a future
   val join_results: 'a future list -> 'a Exn.result list
   val join_result: 'a future -> 'a Exn.result
+  val joins: 'a future list -> 'a list
   val join: 'a future -> 'a
   val join_tasks: task list -> unit
   val value_result: 'a Exn.result -> 'a future
   val value: 'a -> 'a future
+  val cond_forks: fork_params -> (unit -> 'a) list -> 'a future list
   val map: ('a -> 'b) -> 'a future -> 'b future
-  val cond_forks: fork_params -> (unit -> 'a) list -> 'a future list
   val promise_group: group -> (unit -> unit) -> 'a future
   val promise: (unit -> unit) -> 'a future
   val fulfill_result: 'a future -> 'a Exn.result -> unit
@@ -534,6 +535,7 @@
 end;
 
 fun join_result x = singleton join_results x;
+fun joins xs = Par_Exn.release_all (join_results xs);
 fun join x = Exn.release (join_result x);
 
 fun join_tasks [] = ()
@@ -556,6 +558,10 @@
 
 fun value x = value_result (Exn.Res x);
 
+fun cond_forks args es =
+  if Multithreading.enabled () then forks args es
+  else map (fn e => value_result (Exn.interruptible_capture e ())) es;
+
 fun map_future f x =
   let
     val task = task_of x;
@@ -569,16 +575,12 @@
   in
     if extended then Future {promised = false, task = task, result = result}
     else
-      (singleton o forks)
+      (singleton o cond_forks)
         {name = "map_future", group = SOME group, deps = [task],
           pri = Task_Queue.pri_of_task task, interrupts = true}
         (fn () => f (join x))
   end;
 
-fun cond_forks args es =
-  if Multithreading.enabled () then forks args es
-  else map (fn e => value_result (Exn.interruptible_capture e ())) es;
-
 
 (* promised futures -- fulfilled by external means *)
 
--- a/src/Pure/PIDE/document.ML	Sat Aug 20 09:42:34 2011 +0200
+++ b/src/Pure/PIDE/document.ML	Sat Aug 20 15:52:29 2011 +0200
@@ -371,7 +371,7 @@
                         |> set_result result;
                     in ((assigns, execs, [(name, node')]), node') end)
               end))
-      |> Future.join_results |> Par_Exn.release_all |> map #1;
+      |> Future.joins |> map #1;
 
     val state' = state
       |> fold (fold define_exec o #2) updates
--- a/src/Pure/proofterm.ML	Sat Aug 20 09:42:34 2011 +0200
+++ b/src/Pure/proofterm.ML	Sat Aug 20 15:52:29 2011 +0200
@@ -171,8 +171,7 @@
 type oracle = string * term;
 type pthm = serial * (string * term * proof_body future);
 
-fun join_thm (pthm: pthm) = ignore (Future.join (#3 (#2 pthm)));
-fun join_thms thms = (Future.join_results (map (#3 o #2) thms); List.app join_thm thms);
+fun join_thms thms = ignore (Future.joins (map (#3 o #2) thms));
 fun join_body (PBody {thms, ...}) = join_thms thms;
 
 fun proof_of (PBody {proof, ...}) = proof;
--- a/src/Pure/thm.ML	Sat Aug 20 09:42:34 2011 +0200
+++ b/src/Pure/thm.ML	Sat Aug 20 15:52:29 2011 +0200
@@ -515,7 +515,7 @@
 fun fulfill_body (Thm (Deriv {promises, body}, {thy_ref, ...})) =
   Proofterm.fulfill_norm_proof (Theory.deref thy_ref)
     (map #1 promises ~~ fulfill_bodies (map #2 promises)) body
-and fulfill_bodies futures = map fulfill_body (Par_Exn.release_all (Future.join_results futures));
+and fulfill_bodies futures = map fulfill_body (Future.joins futures);
 
 fun join_proofs thms = ignore (map fulfill_body thms);