(* Copyright (C) 2004-2005, HELM Team. * * This file is part of HELM, an Hypertextual, Electronic * Library of Mathematics, developed at the Computer Science * Department, University of Bologna, Italy. * * HELM is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * HELM is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with HELM; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, * MA 02111-1307, USA. * * For details, see the HELM World-Wide-Web page, * http://helm.cs.unibo.it/ *) open Printf (** user hit the cancel button *) exception Cancel (** statement invoked in the wrong context (e.g. tactic with no ongoing proof) *) exception Statement_error of string let statement_error msg = raise (Statement_error msg) exception Command_error of string let command_error msg = raise (Command_error msg) (** parameters are: option name, error message *) exception Option_error of string * string exception Unbound_identifier of string type proof_status = | No_proof | Incomplete_proof of ProofEngineTypes.status | Proof of ProofEngineTypes.proof | Intermediate of Cic.metasenv (* Status in which the proof could be while it is being processed by the * engine. No status entering/exiting the engine could be in it. *) module StringMap = Map.Make (String) type option_value = | String of string | Int of int type options = option_value StringMap.t let no_options = StringMap.empty type status = { aliases: DisambiguateTypes.environment; (** disambiguation aliases *) proof_status: proof_status; options: options; coercions: CoercGraph.coercions; objects: (UriManager.uri * string) list; (** in-scope objects, with their paths *) } let dump_status status = MatitaLog.message "status.aliases:\n"; MatitaLog.message (CicTextualParser2.EnvironmentP3.to_string status.aliases ^ "\n"); MatitaLog.message "status.proof_status:"; MatitaLog.message (match status.proof_status with | No_proof -> "no proof\n" | Incomplete_proof _ -> "incomplete proof\n" | Proof _ -> "proof\n" | Intermediate _ -> "Intermediate\n"); MatitaLog.message "status.options\n"; StringMap.iter (fun k v -> let v = match v with | String s -> s | Int i -> string_of_int i in MatitaLog.message (k ^ "::=" ^ v)) status.options; MatitaLog.message "status.coercions\n"; List.iter (fun (u1,u2,u3) -> MatitaLog.message ((UriManager.string_of_uri u1) ^ (UriManager.string_of_uri u2) ^ (UriManager.string_of_uri u3))) status.coercions; MatitaLog.message "status.objects:\n"; List.iter (fun (u,_) -> MatitaLog.message (UriManager.string_of_uri u)) status.objects let get_option status name = try StringMap.find name status.options with Not_found -> raise (Option_error (name, "not found")) let get_string_option status name = match get_option status name with | String s -> s | _ -> raise (Option_error (name, "not a string value")) let set_option status name value = let mangle_dir s = let s = Str.global_replace (Str.regexp "//+") "/" s in let s = Str.global_replace (Str.regexp "/$") "" s in s in let types = [ "baseuri", (`String, mangle_dir); "basedir", (`String, mangle_dir); ] in let ty_and_mangler = try List.assoc name types with Not_found -> command_error (sprintf "Unknown option \"%s\"" name) in let value = match ty_and_mangler with | `String, f -> String (f value) | `Int, f -> (try Int (int_of_string (f value)) with Failure _ -> command_error (sprintf "Not an integer value \"%s\"" value)) in { status with options = StringMap.add name value status.options } (* subset of MatitaConsole.console methods needed by MatitaInterpreter *) class type console = object method clear : unit -> unit method echo_error : string -> unit method echo_message : string -> unit method wrap_exn : 'a. (unit -> 'a) -> 'a option method choose_uri : string list -> string method show : ?msg:string -> unit -> unit end