- we now use a streaming architecture (run time gain: 11 secs)

[helm.git] / helm / software / lambda-delta / toplevel / top.ml

diff --git a/helm/software/lambda-delta/toplevel/top.ml b/helm/software/lambda-delta/toplevel/top.ml
index dc2bfee9334bc4966ed8f2661e22dbcbb05af290..bb6dcd8433a5536377c26e41a64d82f9f4dafafd 100644 (file)
--- a/helm/software/lambda-delta/toplevel/top.ml
+++ b/helm/software/lambda-delta/toplevel/top.ml
@@ -28,36 +28,65 @@ module MA = MetaAut
 module MO = MetaOutput
 
 let main =
-   let version_string = "Helena Checker 0.8.0 M (June 2008)" in
+   let version_string = "Helena Checker 0.8.0 M - November 2008" in
    let summary = ref 0 in
    let stage = ref 1 in
+   let meta_file = ref None in
    let set_summary i = summary := i in
    let print_version () = print_endline version_string; exit 0 in
    let set_stage i = stage := i in
+   let close = function
+      | None          -> ()
+      | Some (och, _) -> close_out och
+   in
+   let set_meta_file name =
+      close !meta_file;
+      let och = open_out name in
+      let frm = Format.formatter_of_out_channel och in
+      Format.pp_set_margin frm max_int;
+      meta_file := Some (och, frm)
+   in
    let read_file name =
-      if !summary > 0 then
+      if !summary > 0 then Time.gmtime version_string;      
+      if !summary > 1 then
          Printf.printf "Processing file: %s\n" name; flush stdout;
+      if !summary > 0 then Time.utime_stamp "started";
       let ich = open_in name in
       let lexbuf = Lexing.from_channel ich in
       let book = AutParser.book AutLexer.token lexbuf in
       close_in ich;
-      if !summary > 1 then
-        AO.count (AO.print_counters Cps.id) AO.initial_counters book;
-      let f env =
-        if !summary > 1 then
-           MO.count (MO.print_counters Cps.id) MO.initial_counters env;
-         let frm = Format.err_formatter in
-         Format.pp_set_margin frm max_int;
-         MO.pp_environment Cps.id frm (List.rev env)
+      if !summary > 0 then Time.utime_stamp "parsed";
+      let rec aux ac mc st = function
+         | []         -> ac, mc, st
+        | item :: tl -> 
+            let ac = if !summary > 2 then AO.count_item Cps.id ac item else ac in
+           let f st item = 
+              let mc = if !summary > 2 then MO.count_item Cps.id mc item else mc in
+              begin match !meta_file with
+                 | None          -> ()
+                 | Some (_, frm) -> MO.pp_item Cps.id frm item
+              end;
+              st, mc
+           in
+           let st, mc = if !stage > 0 then MA.meta_of_aut f st item else st, mc in
+           aux ac mc st tl
+      in 
+      let ac, mc, _st = 
+         aux AO.initial_counters MO.initial_counters MA.initial_status book
       in
-      if !stage > 0 then MA.meta_of_aut f book
+      if !summary > 0 then Time.utime_stamp "processed";
+      if !summary > 2 then AO.print_counters Cps.id ac;
+      if !summary > 2 && !stage > 0 then MO.print_counters Cps.id mc;
    in
-   let help = "Usage: helena [ -V | -Ss <number> ] <file> ..." in
+   let help = "Usage: helena [ -V | -Ss <number> | -m <file> ] <file> ..." in
    let help_S = "<number>  Set summary level" in
    let help_V = " Show version information" in   
+   let help_m = "<file>  output intermediate representation" in
    let help_s = "<number>  Set translation stage" in
    Arg.parse [
       ("-S", Arg.Int set_summary, help_S);
       ("-V", Arg.Unit print_version, help_V);
+      ("-m", Arg.String set_meta_file, help_m); 
       ("-s", Arg.Int set_stage, help_s);
-   ] read_file help
+   ] read_file help;
+   if !summary > 0 then Time.utime_stamp "at exit"