X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fmatita%2FmatitaTypes.ml;h=13543dbb64d081f4afd1a1a7d2f599a956a11179;hb=771ee8b9d122fa963881c876e86f90531bb7434f;hp=800ae1c7e2c569bc1cb604c7ae5a32d5df16b9fd;hpb=d0582b9f0d2cf4770566da006019c657e23a3c85;p=helm.git diff --git a/helm/matita/matitaTypes.ml b/helm/matita/matitaTypes.ml index 800ae1c7e..13543dbb6 100644 --- a/helm/matita/matitaTypes.ml +++ b/helm/matita/matitaTypes.ml @@ -23,122 +23,14 @@ * http://helm.cs.unibo.it/ *) +(* $Id$ *) + open Printf +open GrafiteTypes (** 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; - 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"; - 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 - type abouts = [ `Blank | `Current_proof @@ -150,8 +42,8 @@ type mathViewer_entry = | `Check of string (* term *) | `Cic of Cic.term * Cic.metasenv | `Dir of string (* "directory" in cic uris namespace *) - | `Uri of string (* cic object uri *) - | `Whelp of string * string list (* query and results *) + | `Uri of UriManager.uri (* cic object uri *) + | `Whelp of string * UriManager.uri list (* query and results *) ] let string_of_entry = function @@ -160,9 +52,17 @@ let string_of_entry = function | `About `Us -> "about:us" | `Check _ -> "check:" | `Cic (_, _) -> "term:" - | `Dir uri | `Uri uri -> uri + | `Dir uri -> uri + | `Uri uri -> UriManager.string_of_uri uri | `Whelp (query, _) -> query +let entry_of_string = function + | "about:blank" -> `About `Blank + | "about:proof" -> `About `Current_proof + | "about:us" -> `About `Us + | _ -> (* only about entries supported ATM *) + raise (Invalid_argument "entry_of_string") + class type mathViewer = object (** @param reuse if set reused last opened cic browser otherwise @@ -170,6 +70,5 @@ class type mathViewer = *) method show_entry: ?reuse:bool -> mathViewer_entry -> unit method show_uri_list: - ?reuse:bool -> entry:mathViewer_entry -> string list -> unit + ?reuse:bool -> entry:mathViewer_entry -> UriManager.uri list -> unit end -