(* *)
(******************************************************************************)
-open Printf;;
+let debug_level = ref 1
+let debug_print ?(level = 1) s = if !debug_level >= level then prerr_endline s
+
+open Printf
(* DEBUGGING *)
(* GLOBAL CONSTANTS *)
-let mqi_flags = [MQIC.Postgres ; MQIC.Stat ; MQIC.Warn ; MQIC.Log] (* default MathQL interpreter options *)
-(*
-let mqi_flags = [] (* default MathQL interpreter options *)
-*)
-let mqi_handle = MQIC.init mqi_flags prerr_string
+let mqi_debug_fun s = debug_print ~level:2 s
+let mqi_flags = [MQIC.Postgres ; MQIC.Stat ; MQIC.Warn ; MQIC.Log]
+let mqi_handle = MQIC.init mqi_flags mqi_debug_fun
let xlinkns = Gdome.domString "http://www.w3.org/1999/xlink";;
match ProofEngine.get_proof () with
None -> assert false
| Some (uri,metasenv,bo,ty) ->
-prerr_endline ("Offending proof: " ^ CicPp.ppobj (Cic.CurrentProof ("questa",metasenv,bo,ty,[]))) ; flush stderr ;
- raise (InvokeTactics.RefreshProofException e)
+ debug_print ("Offending proof: " ^ CicPp.ppobj (Cic.CurrentProof ("questa",metasenv,bo,ty,[])));
+ raise (InvokeTactics.RefreshProofException e)
let set_proof_engine_goal g =
ProofEngine.goal := g
| Some (_,metasenv,_,_) -> metasenv
in
try
-let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in
- prerr_endline ("Offending sequent: " ^ SequentPp.TextualPp.print_sequent currentsequent) ; flush stderr ;
- raise (InvokeTactics.RefreshSequentException e)
-with Not_found -> prerr_endline ("Offending sequent " ^ string_of_int metano ^ " unknown."); raise (InvokeTactics.RefreshSequentException e)
+ let currentsequent = List.find (function (m,_,_) -> m=metano) metasenv in
+ debug_print
+ ("Offending sequent: " ^ SequentPp.TextualPp.print_sequent currentsequent);
+ raise (InvokeTactics.RefreshSequentException e)
+with Not_found ->
+ debug_print ("Offending sequent " ^ string_of_int metano ^ " unknown.");
+ raise (InvokeTactics.RefreshSequentException e)
module InvokeTacticsCallbacks =
struct
let edit_aliases () =
let inputt = ((rendering_window ())#inputt : TermEditor.term_editor) in
- let id_to_uris = inputt#id_to_uris in
+ let id_to_uris = inputt#environment in
let chosen = ref false in
let window =
GWindow.window
ignore (cancelb#connect#clicked window#destroy) ;
ignore
(okb#connect#clicked (function () -> chosen := true ; window#destroy ())) ;
- let resolve_id = !id_to_uris in
ignore
(input#buffer#insert ~iter:(input#buffer#get_iter_at_char 0)
- (Disambiguate_types.Environment.fold
- (fun i v s ->
- match i with
- | Disambiguate_types.Id id -> s ^ sprintf "alias %s %s\n" id (fst v)
- | _ -> "")
- resolve_id "")) ;
-(*
- (function v ->
- let uri =
- match resolve_id v with
- None -> assert false
- | Some (CicTextualParser0.Uri uri) -> uri
- | Some (CicTextualParser0.Term _)
- | Some CicTextualParser0.Implicit -> assert false
- in
- "alias " ^
- (match v with
- CicTextualParser0.Id id -> id
- | CicTextualParser0.Symbol (descr,_) ->
- (* CSC: To be implemented *)
- assert false
- )^ " " ^ (string_of_cic_textual_parser_uri uri)
- )
-*)
+ (DisambiguatingParser.EnvironmentP3.to_string !id_to_uris)) ;
window#show () ;
GtkThread.main ();
if !chosen then
- let resolve_id =
- let inputtext = input#buffer#get_text () in
- let regexpr =
- let alfa = "[a-zA-Z_-]" in
- let digit = "[0-9]" in
- let ident = alfa ^ "\(" ^ alfa ^ "\|" ^ digit ^ "\)*" in
- let blanks = "\( \|\t\|\n\)+" in
- let nonblanks = "[^ \t\n]+" in
- let uri = "/\(" ^ ident ^ "/\)*" ^ nonblanks in (* not very strict check *)
- Str.regexp
- ("alias" ^ blanks ^ "\(" ^ ident ^ "\)" ^ blanks ^ "\(" ^ uri ^ "\)")
- in
- let rec aux n =
- try
- let n' = Str.search_forward regexpr inputtext n in
- let id = Disambiguate_types.Id (Str.matched_group 2 inputtext) in
- let uri = "cic:" ^ (Str.matched_group 5 inputtext) in
- let resolve_id = aux (n' + 1) in
- if Disambiguate_types.Environment.mem id resolve_id then
- resolve_id
- else
- let term = Disambiguate.term_of_uri uri in
- (Disambiguate_types.Environment.add id (uri, (fun _ _ _ -> term))
- resolve_id)
- with
- Not_found -> TermEditor.empty_id_to_uris
- in
- aux 0
- in
- id_to_uris := resolve_id
+ id_to_uris :=
+ DisambiguatingParser.EnvironmentP3.of_string (input#buffer#get_text ())
;;
let proveit () =
(* A WIDGET TO ENTER CIC TERMS *)
-(*
-module ChosenTermEditor = TexTermEditor;;
-module ChosenTextualParser0 = TexCicTextualParser0;;
-*)
-module ChosenTermEditor = TermEditor;;
-module ChosenTextualParser0 = CicTextualParser0;;
-
module Callbacks =
struct
- let get_metasenv () = !ChosenTextualParser0.metasenv
- let set_metasenv metasenv = ChosenTextualParser0.metasenv := metasenv
-
let output_html ?append_NL = output_html ?append_NL (outputhtml ())
let interactive_user_uri_choice =
fun ~selection_mode ?ok ?enable_button_for_non_vars ~title ~msg ~id ->
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:20 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
(*non_empty_type := b ;*)
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:20 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
(* (*non_empty_type := b ;*)
let obj = Cic.InductiveDefinition(tys,params,!paramsno) in
begin
try
- prerr_endline (CicPp.ppobj obj) ;
+ debug_print (CicPp.ppobj obj);
CicTypeChecker.typecheck_mutual_inductive_defs uri
(tys,params,!paramsno) ;
with
e ->
- prerr_endline "Offending mutual (co)inductive type declaration:" ;
- prerr_endline (CicPp.ppobj obj) ;
+ debug_print "Offending mutual (co)inductive type declaration:" ;
+ debug_print (CicPp.ppobj obj) ;
end ;
(* We already know that obj is well-typed. We need to add it to the *)
(* environment in order to compute the inner-types without having to *)
TexTermEditor'.term_editor
mqi_handle
~width:400 ~height:100 ~packing:scrolled_window#add
- ~share_id_to_uris_with:inputt ()
+ ~share_environment_with:inputt ()
~isnotempty_callback:
(function b ->
non_empty_type := b ;
okb#misc#set_sensitive (b && uri_entry#text <> ""))
in
let _ =
-let xxx = inputt#get_as_string in
- newinputt#set_term xxx ;
-(*
- newinputt#set_term inputt#get_as_string ;
-*)
+ newinputt#set_term inputt#get_as_string ;
inputt#reset in
let _ =
uri_entry#connect#changed
| Some p -> aux (new Gdome.element_of_node p)
with
GdomeInit.DOMCastException _ ->
- prerr_endline
+ debug_print
"******* trying to select above the document root ********"
in
match element with
projects / helm.git / blobdiff