From e5b59af8a21c42b504b1beeb89208dd0cb0c8b3b Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Mon, 29 Sep 2014 14:04:59 +0200 Subject: Moved the timing facility to a seperate file. --- cparser/Parse.ml | 6 ++--- driver/Clflags.ml | 50 --------------------------------------- driver/Driver.ml | 1 + driver/Timing.ml | 63 +++++++++++++++++++++++++++++++++++++++++++++++++ extraction/extraction.v | 2 +- 5 files changed, 68 insertions(+), 54 deletions(-) create mode 100644 driver/Timing.ml diff --git a/cparser/Parse.ml b/cparser/Parse.ml index 61b5bc41..59b04e7a 100644 --- a/cparser/Parse.ml +++ b/cparser/Parse.ml @@ -48,7 +48,7 @@ let preprocessed_file transfs name sourcefile = let rec inf = Datatypes.S inf in let ast : Cabs.definition list = Obj.magic - (match Clflags.time2 "Parsing" + (match Timing.time2 "Parsing" Parser.translation_unit_file inf (Lexer.tokens_stream lb) with | Parser.Parser.Inter.Fail_pr -> (* Theoretically impossible : implies inconsistencies @@ -56,8 +56,8 @@ let preprocessed_file transfs name sourcefile = Cerrors.fatal_error "Internal error while parsing" | Parser.Parser.Inter.Timeout_pr -> assert false | Parser.Parser.Inter.Parsed_pr (ast, _ ) -> ast) in - let p1 = Clflags.time "Elaboration" Elab.elab_file ast in - Clflags.time2 "Emulations" transform_program t p1 + let p1 = Timing.time "Elaboration" Elab.elab_file ast in + Timing.time2 "Emulations" transform_program t p1 with | Cerrors.Abort -> [] in diff --git a/driver/Clflags.ml b/driver/Clflags.ml index 76c98924..c6217ba1 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -54,53 +54,3 @@ let option_small_data = then 8 else 0) let option_small_const = ref (!option_small_data) let option_timings = ref false - -(** Timing facility *) - -let timers : (string * float) list ref = ref [] - -let add_to_timer name time = - let rec add = function - | [] -> [name, time] - | (name1, time1 as nt1) :: rem -> - if name1 = name then (name1, time1 +. time) :: rem else nt1 :: add rem - in timers := add !timers - -let time name fn arg = - if not !option_timings then - fn arg - else begin - let start = Sys.time() in - try - let res = fn arg in - add_to_timer name (Sys.time() -. start); - res - with x -> - add_to_timer name (Sys.time() -. start); - raise x - end - -let time2 name fn arg1 arg2 = time name (fun () -> fn arg1 arg2) () -let time3 name fn arg1 arg2 arg3 = time name (fun () -> fn arg1 arg2 arg3) () - -let time_coq name fn arg = - if not !option_timings then - fn arg - else begin - let start = Sys.time() in - try - let res = fn arg in - add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); - res - with x -> - add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); - raise x - end - -let print_timers () = - if !option_timings then - List.iter - (fun (name, time) -> Printf.printf "%7.2fs %s\n" time name) - !timers - -let _ = at_exit print_timers diff --git a/driver/Driver.ml b/driver/Driver.ml index ae397838..7dacc4d2 100644 --- a/driver/Driver.ml +++ b/driver/Driver.ml @@ -13,6 +13,7 @@ open Printf open Camlcoq open Clflags +open Timing (* Location of the compatibility library *) diff --git a/driver/Timing.ml b/driver/Timing.ml new file mode 100644 index 00000000..b45dad40 --- /dev/null +++ b/driver/Timing.ml @@ -0,0 +1,63 @@ +(* *********************************************************************) +(* *) +(* The Compcert verified compiler *) +(* *) +(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *) +(* *) +(* AbsInt Angewandte Informatik GmbH. All rights reserved. This file *) +(* is distributed under the terms of the INRIA Non-Commercial *) +(* License Agreement. *) +(* *) +(* *********************************************************************) + +open Clflags + +(** Timing facility *) + +let timers : (string * float) list ref = ref [] + +let add_to_timer name time = + let rec add = function + | [] -> [name, time] + | (name1, time1 as nt1) :: rem -> + if name1 = name then (name1, time1 +. time) :: rem else nt1 :: add rem + in timers := add !timers + +let time name fn arg = + if not !option_timings then + fn arg + else begin + let start = Sys.time() in + try + let res = fn arg in + add_to_timer name (Sys.time() -. start); + res + with x -> + add_to_timer name (Sys.time() -. start); + raise x + end + +let time2 name fn arg1 arg2 = time name (fun () -> fn arg1 arg2) () +let time3 name fn arg1 arg2 arg3 = time name (fun () -> fn arg1 arg2 arg3) () + +let time_coq name fn arg = + if not !option_timings then + fn arg + else begin + let start = Sys.time() in + try + let res = fn arg in + add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); + res + with x -> + add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); + raise x + end + +let print_timers () = + if !option_timings then + List.iter + (fun (name, time) -> Printf.printf "%7.2fs %s\n" time name) + !timers + +let _ = at_exit print_timers diff --git a/extraction/extraction.v b/extraction/extraction.v index f5556fd1..5b71a150 100644 --- a/extraction/extraction.v +++ b/extraction/extraction.v @@ -104,7 +104,7 @@ Extract Constant Compiler.print_RTL => "PrintRTL.print_if". Extract Constant Compiler.print_LTL => "PrintLTL.print_if". Extract Constant Compiler.print_Mach => "PrintMach.print_if". Extract Constant Compiler.print => "fun (f: 'a -> unit) (x: 'a) -> f x; x". -Extract Constant Compiler.time => "Clflags.time_coq". +Extract Constant Compiler.time => "Timing.time_coq". (*Extraction Inline Compiler.apply_total Compiler.apply_partial.*) -- cgit