]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/software/helena/src/toplevel/top.ml
additional commit for version 0.8.2
[helm.git] / helm / software / helena / src / toplevel / top.ml
index 66baa8658c49a6fe6cbe3feebebd4a14517521d4..ca3abbc529a8f02684149ee7610d32b73cba205e 100644 (file)
@@ -11,6 +11,7 @@
 
 module KF = Filename
 module KP = Printf
+module KS = String
 
 module U  = NUri
 module C  = Cps
@@ -29,11 +30,13 @@ module AO = AutOutput
 module AD = AutCrg
 module XL = XmlLibrary
 module XD = XmlCrg
+module B  = Brg
 module BD = BrgCrg
 module BO = BrgOutput
 module BR = BrgReduction
 module BU = BrgUntrusted
 module BG = BrgGrafite
+module BA = BrgGallina
 module ZD = BagCrg
 module ZO = BagOutput
 module ZT = BagType
@@ -48,7 +51,7 @@ type status = {
    dc : DO.counters;
    bc : BO.counters;
    zc : ZO.counters;
-   och: out_channel option;
+   mst: B.manager option;
 }
 
 let level = 0
@@ -68,7 +71,7 @@ let initial_status () = {
    dc  = DO.initial_counters;
    bc  = BO.initial_counters;
    zc  = ZO.initial_counters;
-   och = None;
+   mst = None;
 }
 
 let refresh_status st = {st with
@@ -133,10 +136,10 @@ let validate st k =
       | BagEntity _      -> st
       | CrgEntity _      -> st
 
-let grafite st och = function
+let manager st output_entity = function
    | BrgEntity entity -> 
-      if BG.output_entity st.kst och entity then st else
-      begin L.warn level "Matita exportation stopped"; {st with och = None} end
+      if output_entity st.kst entity then st else
+      begin L.warn level "manager exportation stopped"; {st with mst = None} end
    | BagEntity _      -> st
    | CrgEntity _      -> st
 
@@ -227,9 +230,9 @@ let process_2 st entity =
       else st
    in
    if !export then export_entity st entity;
-   match st.och with
-     | None     -> st
-     | Some och -> grafite st och entity
+   match st.mst with
+     | None                    -> st
+     | Some (export_entity, _) -> manager st export_entity entity
 
 let process_1 st entity = 
    if !G.trace >= 3 then pp_progress entity;
@@ -307,7 +310,12 @@ let main =
    in 
    let set_preprocess () = 
       if !G.trace >= 2 then begin preprocess := true; G.summary := true end 
-   in 
+   in
+   let set_manager s = match KS.lowercase s with
+      | "v8"  -> G.manager := G.Coq
+      | "ma2" -> G.manager := G.Matita
+      | s     -> L.warn level (KP.sprintf "Unknown manager: %s" s) 
+   in
    let clear_options () =
       export := false; preprocess := false;
       root := "";
@@ -322,12 +330,16 @@ let main =
       let cover = KF.concat !root base_name in
       if !G.stage <= 1 then G.kernel := G.V4;
       G.cover := cover;
-      if !G.ma_preamble <> "" then st := {!st with och = Some (BG.open_out base_name)};
+      begin match !G.manager with
+         | G.Matita -> st := {!st with mst = Some (BG.open_out base_name)}
+         | G.Coq    -> st := {!st with mst = Some (BA.open_out base_name)}
+         | G.Quiet  -> ()
+      end;
       P.clear_marks ();
       let sst, input = process (refresh_status !st) name in
-      st := begin match sst.och with 
-         | None     -> sst
-         | Some och -> BG.close_out och; {sst with och = None}
+      st := begin match sst.mst with 
+         | None                -> sst
+         | Some (_, close_out) -> close_out (); {sst with mst = None}
       end;
       if !G.trace >= 2 then Y.utime_stamp "processed";
       if !G.summary then begin
@@ -342,14 +354,14 @@ let main =
       if !G.trace >= 1 then Y.utime_stamp "at exit"
    in
    let help = 
-      "Usage: helena [ -LPVXdgilopqtx1 | -Ts <number> | -MO <dir> | -m <file> | -ahkr <string> ]* [ <file> ]*\n\n" ^
+      "Usage: helena [ -LPVXdgilopqtx1 | -Ts <number> | -MO <dir> | -c <file> | -ahkmr <string> ]* [ <file> ]*\n\n" ^
       "Trace levels: 0 just errors (default), 1 time stamps, 2 processed files, 3 processed objects,\n" ^
       "              4 typing information, 5 conversion information, 6 reduction information,\n" ^
       "              7 level disambiguation\n\n" ^
       "Stages: 0 parsing, 1 to intermediate, 2 to untrusted, 3 to trusted (default)\n"
    in
    let help_L = " show lexer debug information" in 
-   let help_M = "<dir>  set location of output directory (Grafite) to <dir> (default: current directory)" in
+   let help_M = "<dir>  set location of output directory (manager) to <dir> (default: current directory)" in
    let help_O = "<dir>  set location of output directory (XML) to <dir> (default: current directory)" in
    let help_P = " show parser debug information" in 
    let help_T = "<number>  set trace level (see above)" in
@@ -357,13 +369,14 @@ let main =
    let help_X = " clear options" in
    
    let help_a = "<string>  set prefix of numeric identifiers (default: empty)" in
+   let help_c = "<file>  set preamble to this file (default: empty)" in
    let help_d = " show summary information (requires trace >= 2)" in
    let help_g = " always expand global definitions" in
    let help_h = "<string>  set type hierarchy (default: \"Z1\")" in
    let help_i = " show local references by index" in
    let help_k = "<string>  set kernel version (default: \"V3\")" in
    let help_l = " disambiguate binders level (Automath)" in
-   let help_m = "<file>  export kernel entities (Grafite) setting location of preamble to <file> (default: empty)" in   
+   let help_m = "<string>  export kernel entities for this manager (default: no manager, \"ma2\": Grafite NG, \"v8\": Gallina 8)" in
    let help_o = " activate sort inclusion (default: false)" in
    let help_p = " preprocess source (Automath)" in
    let help_q = " disable quotation of identifiers" in
@@ -376,20 +389,21 @@ let main =
    at_exit exit;
    Arg.parse [
       ("-L", Arg.Set G.debug_lexer, help_L);
-      ("-M", Arg.String ((:=) G.ma_dir), help_M);
+      ("-M", Arg.String ((:=) G.manager_dir), help_M);
       ("-O", Arg.String ((:=) G.xdir), help_O);
       ("-P", Arg.Set G.debug_parser, help_P);
       ("-T", Arg.Int set_trace, help_T);
       ("-V", Arg.Unit print_version, help_V);
       ("-X", Arg.Unit clear_options, help_X);
       ("-a", Arg.String ((:=) G.alpha), help_a);
+      ("-c", Arg.String ((:=) G.preamble), help_c);
       ("-d", Arg.Unit set_summary, help_d);
       ("-g", Arg.Set G.expand, help_g);
       ("-h", Arg.String set_hierarchy, help_h);
       ("-i", Arg.Set G.indexes, help_i);
       ("-k", Arg.String set_kernel, help_k);
       ("-l", Arg.Set G.cc, help_l);
-      ("-m", Arg.String ((:=) G.ma_preamble), help_m);      
+      ("-m", Arg.String set_manager, help_m);      
       ("-o", Arg.Set G.si, help_o);
       ("-p", Arg.Unit set_preprocess, help_p);
       ("-q", Arg.Set G.unquote, help_q);