# HG changeset patch
# User wenzelm
# Date 1296590722 -3600
# Node ID 79716cb61bfd7016616b2ba09150fae0c9e500e2
# Parent  2b80ee995f9559259b9d86f2bf7f93ca7ba322a8
refined task timing: joining vs. waiting;
tuned;

diff -r 2b80ee995f95 -r 79716cb61bfd src/Pure/Concurrent/future.ML
--- a/src/Pure/Concurrent/future.ML	Tue Feb 01 19:39:26 2011 +0100
+++ b/src/Pure/Concurrent/future.ML	Tue Feb 01 21:05:22 2011 +0100
@@ -38,7 +38,6 @@
   val worker_task: unit -> Task_Queue.task option
   val worker_group: unit -> Task_Queue.group option
   val worker_subgroup: unit -> Task_Queue.group
-  val worker_waiting: (unit -> 'a) -> 'a
   type 'a future
   val task_of: 'a future -> task
   val group_of: 'a future -> group
@@ -87,6 +86,11 @@
 val worker_group = Option.map #2 o thread_data;
 fun worker_subgroup () = Task_Queue.new_group (worker_group ());
 
+fun worker_joining e =
+  (case worker_task () of
+    NONE => e ()
+  | SOME task => Task_Queue.joining task e);
+
 fun worker_waiting e =
   (case worker_task () of
     NONE => e ()
@@ -449,11 +453,11 @@
   else
     (case Unsynchronized.change_result queue (Task_Queue.dequeue_towards (Thread.self ()) deps) of
       (NONE, []) => NONE
-    | (NONE, deps') => (worker_wait true work_finished; join_next deps')
+    | (NONE, deps') => (worker_waiting (fn () => worker_wait true work_finished); join_next deps')
     | (SOME work, deps') => SOME (work, deps'));
 
 fun execute_work NONE = ()
-  | execute_work (SOME (work, deps')) = (execute work; join_work deps')
+  | execute_work (SOME (work, deps')) = (worker_joining (fn () => execute work); join_work deps')
 and join_work deps =
   execute_work (SYNCHRONIZED "join" (fn () => join_next deps));
 
@@ -464,15 +468,16 @@
 in
 
 fun join_results xs =
-  if forall is_finished xs then map get_result xs
-  else if Multithreading.self_critical () then
-    error "Cannot join future values within critical section"
-  else
-    worker_waiting (fn () =>
-      (case worker_task () of
-        SOME task => join_depend task (map task_of xs)
-      | NONE => List.app (ignore o Single_Assignment.await o result_of) xs;
-      map get_result xs));
+  let
+    val _ =
+      if forall is_finished xs then ()
+      else if Multithreading.self_critical () then
+        error "Cannot join future values within critical section"
+      else
+        (case worker_task () of
+          SOME task => join_depend task (map task_of xs)
+        | NONE => List.app (ignore o Single_Assignment.await o result_of) xs);
+  in map get_result xs end;
 
 end;
 
diff -r 2b80ee995f95 -r 79716cb61bfd src/Pure/Concurrent/task_queue.ML
--- a/src/Pure/Concurrent/task_queue.ML	Tue Feb 01 19:39:26 2011 +0100
+++ b/src/Pure/Concurrent/task_queue.ML	Tue Feb 01 21:05:22 2011 +0100
@@ -12,6 +12,7 @@
   val str_of_task: task -> string
   val timing_of_task: task -> Time.time * Time.time
   val running: task -> (unit -> 'a) -> 'a
+  val joining: task -> (unit -> 'a) -> 'a
   val waiting: task -> (unit -> 'a) -> 'a
   type group
   val new_group: group option -> group
@@ -50,14 +51,14 @@
 type timing = Time.time * Time.time;
 
 fun new_timing () =
-  Synchronized.var "Task_Queue.timing" (Time.zeroTime, Time.zeroTime);
+  Synchronized.var "timing" (Time.zeroTime, Time.zeroTime);
 
-fun gen_timing which timing e =
+fun gen_timing account timing e =
   let
     val start = Time.now ();
     val result = Exn.capture e ();
     val t = Time.- (Time.now (), start);
-    val _ = Synchronized.change timing (which (fn t' => Time.+ (t, t')));
+    val _ = Synchronized.change timing (account t);
   in Exn.release result end;
 
 
@@ -78,8 +79,11 @@
   if name = "" then string_of_int id else string_of_int id ^ " (" ^ name ^ ")";
 
 fun timing_of_task (Task {timing, ...}) = Synchronized.value timing;
-fun running (Task {timing, ...}) = gen_timing apfst timing;
-fun waiting (Task {timing, ...}) = gen_timing apsnd timing;
+
+fun running (Task {timing, ...}) = gen_timing (fn t => fn (a, b) => (Time.+ (a, t), b)) timing;
+fun joining (Task {timing, ...}) = gen_timing (fn t => fn (a, b) => (Time.- (a, t), b)) timing;
+fun waiting (Task {timing, ...}) =
+  gen_timing (fn t => fn (a, b) => (Time.- (a, t), Time.+ (b, t))) timing;
 
 fun task_ord (Task {id = id1, pri = pri1, ...}, Task {id = id2, pri = pri2, ...}) =
   prod_ord (rev_order o option_ord int_ord) int_ord ((pri1, id1), (pri2, id2));