# HG changeset patch # User wenzelm # Date 1120672837 -7200 # Node ID 4399016bf13e3eb78c8c5b89b451b0dd950d48aa # Parent 597830f91930fa27bc549f1e9c68318ee1b40044 added time_accumulator and accumulated_time supercede low-level time_info operations; diff -r 597830f91930 -r 4399016bf13e src/Pure/General/output.ML --- a/src/Pure/General/output.ML Wed Jul 06 20:00:34 2005 +0200 +++ b/src/Pure/General/output.ML Wed Jul 06 20:00:37 2005 +0200 @@ -48,13 +48,7 @@ val timeit: (unit -> 'a) -> 'a val timeap: ('a -> 'b) -> 'a -> 'b val timeap_msg: string -> ('a -> 'b) -> 'a -> 'b - type time_info - val time_init: unit -> time_info ref - val time_reset: time_info ref -> unit - val time_check: time_info ref -> {timer: Timer.cpu_timer, - sys: Time.time, usr: Time.time, gc: Time.time, count: int} - val time_finish: string -> time_info ref -> unit - val time: time_info ref -> ('a -> 'b) -> 'a -> 'b + val time_accumulator: string -> ('a -> 'b) -> 'a -> 'b end; signature OUTPUT = @@ -69,6 +63,7 @@ val add_mode: string -> (string -> string * real) * (string * int -> string) * (string -> string) -> unit val transform_exceptions: bool ref + val accumulated_time: unit -> unit end; structure Output: OUTPUT = @@ -244,51 +239,68 @@ local -fun add_interval time time1 time2 = - Time.+ (time, Time.- (time2, time1) handle Time.Time => Time.zeroTime); - -fun secs prfx time = prfx ^ Time.toString time; - -in - datatype time_info = TI of - {timer: Timer.cpu_timer, + {name: string, + timer: Timer.cpu_timer, sys: Time.time, usr: Time.time, gc: Time.time, count: int}; -fun time_init () = ref (TI {timer = Timer.startCPUTimer (), - sys = Time.zeroTime, usr = Time.zeroTime, gc = Time.zeroTime, count = 0}); +fun time_init name = ref (TI + {name = name, + timer = Timer.startCPUTimer (), + sys = Time.zeroTime, + usr = Time.zeroTime, + gc = Time.zeroTime, + count = 0}); -fun time_reset r = r := ! (time_init ()); +fun time_reset (r as ref (TI {name, ...})) = r := ! (time_init name); fun time_check (ref (TI r)) = r; -fun time_finish name ti = - let val {timer, sys, usr, gc, count} = time_check ti in - info ("Total of " ^ quote name ^ ": " ^ - secs "User " usr ^ secs " GC " gc ^ secs " All " (Time.+ (sys, Time.+ (usr, gc))) ^ - " secs in " ^ string_of_int count ^ " calls"); - ti := TI {timer = timer, sys = Time.zeroTime, usr = Time.zeroTime, - gc = Time.zeroTime, count = 0} - end; - -fun time ti f x = +fun time_add ti f x = let - val {timer, sys, usr, gc, count} = time_check ti; + fun add_diff time time1 time2 = + Time.+ (time, Time.- (time2, time1) handle Time.Time => Time.zeroTime); + val {name, timer, sys, usr, gc, count} = time_check ti; val (sys1, usr1, gc1) = checkTimer timer; val result = capture f x; val (sys2, usr2, gc2) = checkTimer timer; in - ti := TI {timer = timer, - sys = add_interval sys sys1 sys2, - usr = add_interval usr usr1 usr2, - gc = add_interval gc gc1 gc2, + ti := TI + {name = name, + timer = timer, + sys = add_diff sys sys1 sys2, + usr = add_diff usr usr1 usr2, + gc = add_diff gc gc1 gc2, count = count + 1}; release result end; +fun time_finish ti = + let + fun secs prfx time = prfx ^ Time.toString time; + val {name, timer, sys, usr, gc, count} = time_check ti; + in + info ("Total of " ^ quote name ^ ": " ^ + secs "User " usr ^ secs " GC " gc ^ secs " All " (Time.+ (sys, Time.+ (usr, gc))) ^ + " secs in " ^ string_of_int count ^ " calls"); + time_reset ti + end; + +val time_finish_hooks = ref ([]: (unit -> unit) list); + +in + +fun time_accumulator name = + let val ti = time_init name in + change time_finish_hooks (cons (fn () => time_finish ti)); + time_add ti + end; + +fun accumulated_time () = List.app (fn f => f ()) (! time_finish_hooks); + end; end;