# HG changeset patch
# User wenzelm
# Date 1358527910 -3600
# Node ID 73ec6ad6700ec00d7c7e29d074b1666bbbe31b3f
# Parent  55f8bd61b029824683f8f4970338623401cd2bb7
more systematic task statistics;

diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/Concurrent/future.ML
--- a/src/Pure/Concurrent/future.ML	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/Concurrent/future.ML	Fri Jan 18 17:51:50 2013 +0100
@@ -256,12 +256,11 @@
       Task_Queue.running task (fn () =>
         setmp_worker_task task (fn () =>
           fold (fn job => fn ok => job valid andalso ok) jobs true) ());
-    val _ = Multithreading.tracing 2 (fn () =>
-      let
-        val s = Task_Queue.str_of_task_groups task;
-        fun micros time = string_of_int (Time.toNanoseconds time div 1000);
-        val (run, wait, deps) = Task_Queue.timing_of_task task;
-      in "TASK " ^ s ^ " " ^ micros run ^ " " ^ micros wait ^ " (" ^ commas deps ^ ")" end);
+    val _ =
+      if ! Multithreading.trace >= 2 then
+        Output.protocol_message (Markup.task_statistics :: Task_Queue.task_statistics task) ""
+          handle Fail msg => warning msg
+      else ();
     val _ = SYNCHRONIZED "finish" (fn () =>
       let
         val maximal = Unsynchronized.change_result queue (Task_Queue.finish task);
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/Concurrent/task_queue.ML
--- a/src/Pure/Concurrent/task_queue.ML	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/Concurrent/task_queue.ML	Fri Jan 18 17:51:50 2013 +0100
@@ -22,7 +22,7 @@
   val pri_of_task: task -> int
   val str_of_task: task -> string
   val str_of_task_groups: task -> string
-  val timing_of_task: task -> Time.time * Time.time * string list
+  val task_statistics: task -> Properties.T
   val running: task -> (unit -> 'a) -> 'a
   val joining: task -> (unit -> 'a) -> 'a
   val waiting: task -> task list -> (unit -> 'a) -> 'a
@@ -114,14 +114,17 @@
   name: string,
   id: int,
   pri: int option,
-  timing: timing Synchronized.var option}
+  timing: timing Synchronized.var option,
+  pos: Position.T}
 with
 
 val dummy_task =
-  Task {group = new_group NONE, name = "", id = 0, pri = NONE, timing = NONE};
+  Task {group = new_group NONE, name = "", id = 0, pri = NONE, timing = NONE,
+    pos = Position.none};
 
 fun new_task group name pri =
-  Task {group = group, name = name, id = new_id (), pri = pri, timing = new_timing ()};
+  Task {group = group, name = name, id = new_id (), pri = pri, timing = new_timing (),
+    pos = Position.thread_data ()};
 
 fun group_of_task (Task {group, ...}) = group;
 fun name_of_task (Task {name, ...}) = name;
@@ -132,9 +135,6 @@
 
 fun str_of_task_groups task = str_of_task task ^ " in " ^ str_of_groups (group_of_task task);
 
-fun timing_of_task (Task {timing, ...}) =
-  (case timing of NONE => timing_start | SOME var => Synchronized.value var);
-
 fun update_timing update (Task {timing, ...}) e =
   uninterruptible (fn restore_attributes => fn () =>
     let
@@ -147,6 +147,18 @@
 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));
 
+fun task_statistics (Task {name, id, timing, pos, ...}) =
+  let
+    val (run, wait, wait_deps) =
+      (case timing of NONE => timing_start | SOME var => Synchronized.value var);
+    fun micros time = string_of_int (Time.toNanoseconds time div 1000);
+  in
+    [("now", signed_string_of_real (Time.toReal (Time.now ()))),
+     ("task_name", name), ("task_id", Markup.print_int id),
+     ("run", micros run), ("wait", micros wait), ("wait_deps", commas wait_deps)] @
+    Position.properties_of pos
+  end;
+
 end;
 
 structure Tasks = Table(type key = task val ord = task_ord);
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/PIDE/markup.ML
--- a/src/Pure/PIDE/markup.ML	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/PIDE/markup.ML	Fri Jan 18 17:51:50 2013 +0100
@@ -134,6 +134,7 @@
   val invoke_scala: string -> string -> Properties.T
   val cancel_scala: string -> Properties.T
   val ML_statistics: Properties.entry
+  val task_statistics: Properties.entry
   val loading_theory: string -> Properties.T
   val dest_loading_theory: Properties.T -> string option
   val no_output: Output.output * Output.output
@@ -412,6 +413,8 @@
 
 val ML_statistics = (functionN, "ML_statistics");
 
+val task_statistics = (functionN, "task_statistics");
+
 fun loading_theory name = [("function", "loading_theory"), ("name", name)];
 
 fun dest_loading_theory [("function", "loading_theory"), ("name", name)] = SOME name
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/PIDE/markup.scala
--- a/src/Pure/PIDE/markup.scala	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/PIDE/markup.scala	Fri Jan 18 17:51:50 2013 +0100
@@ -330,6 +330,15 @@
         case _ => None
       }
   }
+
+  object Task_Statistics
+  {
+    def unapply(props: Properties.T): Option[Properties.T] =
+      props match {
+        case (FUNCTION, "task_statistics") :: stats => Some(stats)
+        case _ => None
+      }
+  }
 }
 
 
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/System/session.scala
--- a/src/Pure/System/session.scala	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/System/session.scala	Fri Jan 18 17:51:50 2013 +0100
@@ -364,6 +364,9 @@
         case Markup.ML_Statistics(props) if output.is_protocol =>
           statistics.event(Session.Statistics(props))
 
+        case Markup.Task_Statistics(props) if output.is_protocol =>
+          // FIXME
+
         case _ if output.is_init =>
           phase = Session.Ready
 
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/Tools/build.ML
--- a/src/Pure/Tools/build.ML	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/Tools/build.ML	Fri Jan 18 17:51:50 2013 +0100
@@ -19,13 +19,21 @@
       else NONE
   | ML_statistics _ _ = NONE;
 
+fun task_statistics (function :: stats) "" =
+      if function = Markup.task_statistics then SOME stats
+      else NONE
+  | task_statistics _ _ = NONE;
+
 fun protocol_message props output =
   (case ML_statistics props output of
     SOME stats => writeln ("\fML_statistics = " ^ ML_Syntax.print_properties stats)
   | NONE =>
-      (case Markup.dest_loading_theory props of
-        SOME name => writeln ("\floading_theory = " ^ name)
-      | NONE => raise Fail "Undefined Output.protocol_message"));
+      (case task_statistics props output of
+        SOME stats => writeln ("\ftask_statistics = " ^ ML_Syntax.print_properties stats)
+      | NONE =>
+          (case Markup.dest_loading_theory props of
+            SOME name => writeln ("\floading_theory = " ^ name)
+          | NONE => raise Fail "Undefined Output.protocol_message")));
 
 
 (* build *)
diff -r 55f8bd61b029 -r 73ec6ad6700e src/Pure/Tools/build.scala
--- a/src/Pure/Tools/build.scala	Fri Jan 18 16:20:09 2013 +0100
+++ b/src/Pure/Tools/build.scala	Fri Jan 18 17:51:50 2013 +0100
@@ -561,14 +561,16 @@
   private val SESSION_PARENT_PATH = "\fSession.parent_path = "
 
 
-  sealed case class Log_Info(stats: List[Properties.T], timing: Properties.T)
+  sealed case class Log_Info(
+    stats: List[Properties.T], tasks: List[Properties.T], timing: Properties.T)
 
   def parse_log(text: String): Log_Info =
   {
     val lines = split_lines(text)
     val stats = Props.parse_lines("\fML_statistics = ", lines)
+    val tasks = Props.parse_lines("\ftask_statistics = ", lines)
     val timing = Props.find_parse_line("\fTiming = ", lines) getOrElse Nil
-    Log_Info(stats, timing)
+    Log_Info(stats, tasks, timing)
   }