additional timing status for implicitly forked terminal proofs -- proper accounting for interactive Timing dockable etc.;
authorwenzelm
Wed, 03 Apr 2013 21:48:43 +0200
changeset 527432843cc095a57
parent 52742 eca8acb42e4a
child 52744 ee3398dfee9a
additional timing status for implicitly forked terminal proofs -- proper accounting for interactive Timing dockable etc.;
src/Pure/General/timing.ML
src/Pure/Isar/proof.ML
src/Pure/PIDE/markup.ML
src/Pure/ROOT.ML
     1.1 --- a/src/Pure/General/timing.ML	Wed Apr 03 21:30:32 2013 +0200
     1.2 +++ b/src/Pure/General/timing.ML	Wed Apr 03 21:48:43 2013 +0200
     1.3 @@ -23,6 +23,7 @@
     1.4    val is_relevant_time: Time.time -> bool
     1.5    val is_relevant: timing -> bool
     1.6    val message: timing -> string
     1.7 +  val status: ('a -> 'b) -> 'a -> 'b
     1.8  end
     1.9  
    1.10  structure Timing: TIMING =
    1.11 @@ -89,10 +90,10 @@
    1.12  fun cond_timeit enabled msg e =
    1.13    if enabled then
    1.14      let
    1.15 -      val (timing, result) = timing (Exn.interruptible_capture e) ();
    1.16 +      val (t, result) = timing (Exn.interruptible_capture e) ();
    1.17        val _ =
    1.18 -        if is_relevant timing then
    1.19 -          let val end_msg = message timing
    1.20 +        if is_relevant t then
    1.21 +          let val end_msg = message t
    1.22            in warning (if msg = "" then end_msg else msg ^ "\n" ^ end_msg) end
    1.23          else ();
    1.24      in Exn.release result end
    1.25 @@ -102,6 +103,12 @@
    1.26  fun timeap f x = timeit (fn () => f x);
    1.27  fun timeap_msg msg f x = cond_timeit true msg (fn () => f x);
    1.28  
    1.29 +fun status f x =
    1.30 +  let
    1.31 +    val (t, result) = timing (Exn.interruptible_capture f) x;
    1.32 +    val _ = if is_relevant t then Output.status (Markup.markup_only (Markup.timing t)) else ();
    1.33 +  in Exn.release result end;
    1.34 +
    1.35  end;
    1.36  
    1.37  structure Basic_Timing: BASIC_TIMING = Timing;
     2.1 --- a/src/Pure/Isar/proof.ML	Wed Apr 03 21:30:32 2013 +0200
     2.2 +++ b/src/Pure/Isar/proof.ML	Wed Apr 03 21:48:43 2013 +0200
     2.3 @@ -1163,7 +1163,7 @@
     2.4      state |> future_proof (fn state' =>
     2.5        Goal.fork_params
     2.6          {name = "Proof.future_terminal_proof", pos = Position.thread_data (), pri = ~1}
     2.7 -        (fn () => ((), proof2 state'))) |> snd |> done
     2.8 +        (fn () => ((), Timing.status proof2 state'))) |> snd |> done
     2.9    else proof1 state;
    2.10  
    2.11  in
     3.1 --- a/src/Pure/PIDE/markup.ML	Wed Apr 03 21:30:32 2013 +0200
     3.2 +++ b/src/Pure/PIDE/markup.ML	Wed Apr 03 21:48:43 2013 +0200
     3.3 @@ -94,14 +94,14 @@
     3.4    val cpuN: string
     3.5    val gcN: string
     3.6    val timing_propertiesN: string list
     3.7 -  val timing_properties: Timing.timing -> Properties.T
     3.8 -  val parse_timing_properties: Properties.T -> Timing.timing
     3.9 +  val timing_properties: {elapsed: Time.time, cpu: Time.time, gc: Time.time} -> Properties.T
    3.10 +  val parse_timing_properties: Properties.T -> {elapsed: Time.time, cpu: Time.time, gc: Time.time}
    3.11    val command_timingN: string
    3.12    val command_timing_properties:
    3.13      {file: string, offset: int, name: string} -> Time.time -> Properties.T
    3.14    val parse_command_timing_properties:
    3.15      Properties.T -> ({file: string, offset: int, name: string} * Time.time) option
    3.16 -  val timingN: string val timing: Timing.timing -> T
    3.17 +  val timingN: string val timing: {elapsed: Time.time, cpu: Time.time, gc: Time.time} -> T
    3.18    val subgoalsN: string
    3.19    val proof_stateN: string val proof_state: int -> T
    3.20    val stateN: string val state: T
     4.1 --- a/src/Pure/ROOT.ML	Wed Apr 03 21:30:32 2013 +0200
     4.2 +++ b/src/Pure/ROOT.ML	Wed Apr 03 21:48:43 2013 +0200
     4.3 @@ -28,9 +28,9 @@
     4.4  
     4.5  use "General/properties.ML";
     4.6  use "General/output.ML";
     4.7 -use "General/timing.ML";
     4.8  use "PIDE/markup.ML";
     4.9  fun legacy_feature s = warning (Markup.markup Markup.legacy ("Legacy feature! " ^ s));
    4.10 +use "General/timing.ML";
    4.11  use "General/scan.ML";
    4.12  use "General/source.ML";
    4.13  use "General/symbol.ML";