-(* Copyright (C) 2004, HELM Team.
+(* Copyright (C) 2004-2005, HELM Team.
*
* This file is part of HELM, an Hypertextual, Electronic
* Library of Mathematics, developed at the Computer Science
open MatitaTypes
-let message s = printf "** MatitaC: %s\n" s; flush stdout
-let warn s = eprintf "** MatitaC WARNING: %s\n" s; flush stdout
-let error s = eprintf "** MatitaC ERROR: %s\n" s; flush stderr
-
- (** console which prints on stdout/stderr *)
-class tty_console =
- object (self)
- method clear () = ()
- method echo_message s = message s
- method echo_error s = error s
- (* TODO Zack: this method is similar to omonymous method in console,
- * factorize it in a common super class *)
- method wrap_exn: 'a. (unit -> 'a) -> 'a option =
- fun f ->
- try
- Some (f ())
- with exn ->
- self#echo_error (explain exn);
- None
- method show ?(msg = "") () = assert false; ()
- method choose_uri (uris: string list): string = assert false
- end
-
(** {2 Initialization} *)
let arg_spec = [
Arg.parse arg_spec add_script usage;
List.rev !acc
-let console = new tty_console
-let interpreter = MatitaInterpreter.interpreter ~console ()
-
let run_script fname =
- message (sprintf "execution of %s started:" fname);
- let script =
- let ic = open_in fname in
- let ast =
- try
- snd (CicTextualParser2.parse_script (Stream.of_channel ic))
- with
- exn ->
- error (explain exn);
- assert false (* should be something like (Unix.exit 1) *)
- in
- close_in ic;
- ast
+ let is =
+ Stream.of_channel
+ (match fname with
+ | "stdin" -> stdin
+ | fname -> open_in fname)
in
- let rec aux = function
- | [] -> () (* script is over *)
- | DisambiguateTypes.Comment _ :: tl -> aux tl
- | DisambiguateTypes.Command ast :: tl ->
- let loc =
- match ast with
- | TacticAst.LocatedTactical (loc, _) -> loc
- | _ -> assert false
- in
- let (success, _) = interpreter#evalAst ast in
- if not success then
- error (sprintf "%s: error at %s, aborting." fname
- (CicAst.pp_location loc))
- else
- aux tl
+ let status = ref (Lazy.force MatitaEngine.initial_status) in
+ let slash_n_RE = Pcre.regexp "\\n" in
+ let cb status stm =
+ (* dump_status status; *)
+ let stm = TacticAstPp.pp_statement stm in
+ let stm = Pcre.replace ~rex:slash_n_RE stm in
+ let stm =
+ if String.length stm > 50 then
+ String.sub stm 0 50 ^ " ..."
+ else
+ stm
+ in
+ MatitaLog.debug ("Executing: ``" ^ stm ^ "''")
in
- aux script;
- message (sprintf "execution of %s completed." fname)
-
-let _ = List.iter run_script scripts
+ try
+ status := MatitaEngine.eval_from_stream !status is cb
+ with
+ | CicTextualParser2.Parse_error (floc,err) ->
+ let (x, y) = CicAst.loc_of_floc floc in
+ MatitaLog.message (sprintf "Parse error at %d-%d: %s" x y err);
+ Http_getter.sync_dump_file ();
+ exit 1
+ | exn ->
+ MatitaLog.error (Printexc.to_string exn);
+ raise exn
+
+let _ =
+ List.iter (fun fname ->
+ let time = Unix.time () in
+ MatitaLog.message (sprintf "execution of %s started:" fname);
+ run_script fname;
+ let elapsed = Unix.time () -. time in
+ let tm = Unix.gmtime elapsed in
+ let sec =
+ if tm.Unix.tm_sec > 0 then (string_of_int tm.Unix.tm_sec ^ "''") else ""
+ in
+ let min =
+ if tm.Unix.tm_min > 0 then (string_of_int tm.Unix.tm_min ^ "' ") else ""
+ in
+ let hou =
+ if tm.Unix.tm_hour > 0 then (string_of_int tm.Unix.tm_hour ^ "h ") else ""
+ in
+ MatitaLog.message
+ (sprintf "execution of %s completed in %s." fname (hou^min^sec))) scripts;
+ Http_getter.sync_dump_file ();
+ exit(0)
+