# HG changeset patch # User wenzelm # Date 1313848349 -7200 # Node ID b28e091f683aed46a93441b4381d72e73ac8ca64 # Parent 6325ea1c5dfd5349c48117db142863f8c9a76194 added Future.joins convenience; clarified Future.map: based on Future.cond_forks; diff -r 6325ea1c5dfd -r b28e091f683a src/Pure/Concurrent/future.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 *) diff -r 6325ea1c5dfd -r b28e091f683a src/Pure/PIDE/document.ML --- 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 diff -r 6325ea1c5dfd -r b28e091f683a src/Pure/proofterm.ML --- 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; diff -r 6325ea1c5dfd -r b28e091f683a src/Pure/thm.ML --- 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);