-let pp_ocaml_mode () =
- HLog.message "";
- HLog.message " ** Entering Ocaml mode ** ";
- HLog.message "";
- HLog.message "Type 'go ();;' to enter an interactive matitac";
- HLog.message ""
-
-let clean_exit n =
- let opt_exit =
- function
- None -> ()
- | Some n -> exit n
- in
- match !grafite_status with
- None -> opt_exit n
- | Some grafite_status ->
- try
- let baseuri = GrafiteTypes.get_string_option grafite_status "baseuri" in
- let basedir = Helm_registry.get "matita.basedir" in
- LibraryClean.clean_baseuris ~basedir ~verbose:false [baseuri];
- opt_exit n
- with GrafiteTypes.Option_error("baseuri", "not found") ->
- (* no baseuri ==> nothing to clean yet *)
- opt_exit n
-
-let rec interactive_loop () =
- let str = Ulexing.from_utf8_channel stdin in
- try
- run_script str
- (MatitaEngine.eval_from_stream ~first_statement_only:false ~prompt:true
- ~include_paths:(Helm_registry.get_list Helm_registry.string
- "matita.includes"))
- with
- | GrafiteEngine.Drop -> pp_ocaml_mode ()
- | GrafiteEngine.Macro (floc,_) ->
- let x, y = HExtlib.loc_of_floc floc in
- HLog.error
- (sprintf "A macro has been found in a script at %d-%d" x y);
- interactive_loop ()
- | Sys.Break -> HLog.error "user break!"; interactive_loop ()
- | GrafiteTypes.Command_error _ -> interactive_loop ()
- | End_of_file ->
- print_newline ();
- clean_exit (Some 0)
- | HExtlib.Localized (floc,CicNotationParser.Parse_error err) ->
- let x, y = HExtlib.loc_of_floc floc in
- HLog.error (sprintf "Parse error at %d-%d: %s" x y err);
- interactive_loop ()
- | exn -> HLog.error (Printexc.to_string exn); interactive_loop ()
+let dump f =
+ let module G = GrafiteAst in
+ let module L = LexiconAst in
+ let module H = HExtlib in
+ Helm_registry.set_bool "matita.moo" false;
+ let floc = H.dummy_floc in
+ let nl_ast = G.Comment (floc, G.Note (floc, "")) in
+ let och = open_out f in
+ let out_comment och s =
+ let s = if s <> "" && s.[0] = '*' then "#" ^ s else s in
+ Printf.fprintf och "%s%s%s\n\n" "(*" s "*)"
+ in
+ let out_line_comment och s =
+ let l = 70 - String.length s in
+ let s = Printf.sprintf " %s %s" s (String.make l '*') in
+ out_comment och s
+ in
+ let out_preamble och (path, lines) =
+ let ich = open_in path in
+ let rec print i =
+ if i > 0 then
+ let s = input_line ich in
+ begin Printf.fprintf och "%s\n" s; print (pred i) end
+ in
+ print lines;
+ out_line_comment och "This file was automatically generated: do not edit"
+ in
+ let pp_ast_statement st =
+ GrafiteAstPp.pp_statement ~term_pp:CicNotationPp.pp_term
+ ~map_unicode_to_tex:(Helm_registry.get_bool
+ "matita.paste_unicode_as_tex")
+ ~lazy_term_pp:CicNotationPp.pp_term
+ ~obj_pp:(CicNotationPp.pp_obj CicNotationPp.pp_term) st
+ in
+ let nl () = output_string och (pp_ast_statement nl_ast) in
+ let rt_base_dir = Filename.dirname Sys.argv.(0) in
+ let path = Filename.concat rt_base_dir "matita.ma.templ" in
+ let lines = 14 in
+ out_preamble och (path, lines);
+ let grafite_parser_cb fname =
+ let ast = G.Executable
+ (floc, G.Command (floc, G.Include (floc, fname))) in
+ output_string och (pp_ast_statement ast); nl (); nl ()
+ in
+ let matita_engine_cb = function
+ | G.Executable (_, G.Macro (_, G.Inline _))
+ | G.Executable (_, G.Command (_, G.Include _)) -> ()
+ | ast ->
+ output_string och (pp_ast_statement ast); nl (); nl ()
+ in
+ let matitac_lib_cb = output_string och in
+ GrafiteParser.set_callback grafite_parser_cb;
+ MatitaEngine.set_callback matita_engine_cb;
+ set_callback matitac_lib_cb;
+ fun x ->
+ close_out och;
+ GrafiteParser.set_callback ignore;
+ MatitaEngine.set_callback ignore;
+ set_callback ignore; x
+;;
+
+let get_macro_context = function
+ | Some {GrafiteTypes.proof_status = GrafiteTypes.No_proof} -> []
+ | Some status ->
+ let stack = GrafiteTypes.get_stack status in
+ let goal = Continuationals.Stack.find_goal stack in
+ GrafiteTypes.get_proof_context status goal
+ | None -> assert false
+;;
+
+let pp_times fname rc big_bang big_bang_u big_bang_s =
+ if not (Helm_registry.get_bool "matita.verbose") then
+ let { Unix.tms_utime = u ; Unix.tms_stime = s} = Unix.times () in
+ let r = Unix.gettimeofday () -. big_bang in
+ let u = u -. big_bang_u in
+ let s = s -. big_bang_s in
+ let extra = try Sys.getenv "BENCH_EXTRA_TEXT" with Not_found -> "" in
+ let rc,rcascii =
+ if rc then "\e[0;32mOK\e[0m","Ok" else "\e[0;31mFAIL\e[0m","Fail" in
+ let times =
+ let fmt t =
+ let seconds = int_of_float t in
+ let cents = int_of_float ((t -. floor t) *. 100.0) in
+ let minutes = seconds / 60 in
+ let seconds = seconds mod 60 in
+ Printf.sprintf "%dm%02d.%02ds" minutes seconds cents
+ in
+ Printf.sprintf "%s %s %s" (fmt r) (fmt u) (fmt s)
+ in
+ let s = Printf.sprintf "%-4s %s %s" rc times extra in
+ print_endline s;
+ flush stdout;
+ HLog.message ("Compilation of "^Filename.basename fname^": "^rc)
+;;