X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=helm%2Fsoftware%2Fmatita%2FmatitaMathView.ml;h=4b54f60ac1e7f36bdd355147166e9790f53476fa;hb=b63a54790055e05654c03d2aaff604c66995557b;hp=1d636ef8b88e7e63865f9b7cb45d59a7b5273cd7;hpb=5b72c06c73ae9493ef7df7f8ca10fd95d02983e1;p=helm.git
diff --git a/helm/software/matita/matitaMathView.ml b/helm/software/matita/matitaMathView.ml
index 1d636ef8b..4b54f60ac 100644
--- a/helm/software/matita/matitaMathView.ml
+++ b/helm/software/matita/matitaMathView.ml
@@ -246,21 +246,33 @@ object (self)
| _ -> leave_href ())
| None -> leave_href ()
+ method private tactic_text_pattern_of_node node =
+ let id = id_of_node node in
+ let cic_info, unsh_sequent = self#get_cic_info id in
+ match self#get_term_by_id cic_info id with
+ | SelTerm (t, father_hyp) ->
+ let sequent = self#sequent_of_id ~paste_kind:`Pattern id in
+ let text = self#string_of_cic_sequent sequent in
+ (match father_hyp with
+ | None -> None, [], Some text
+ | Some hyp_name -> None, [ hyp_name, text ], None)
+ | SelHyp (hyp_name, _ctxt) -> None, [ hyp_name, "%" ], None
+
+ method private tactic_text_of_node node =
+ let id = id_of_node node in
+ let cic_info, unsh_sequent = self#get_cic_info id in
+ match self#get_term_by_id cic_info id with
+ | SelTerm (t, father_hyp) ->
+ let sequent = self#sequent_of_id ~paste_kind:`Term id in
+ let text = self#string_of_cic_sequent sequent in
+ text
+ | SelHyp (hyp_name, _ctxt) -> hyp_name
+
(** @return a pattern structure which contains pretty printed terms *)
method private tactic_text_pattern_of_selection =
match self#get_selections with
| [] -> assert false (* this method is invoked only if there's a sel. *)
- | node :: _ ->
- let id = id_of_node node in
- let cic_info, unsh_sequent = self#get_cic_info id in
- match self#get_term_by_id cic_info id with
- | SelTerm (t, father_hyp) ->
- let sequent = self#sequent_of_id ~paste_kind:`Pattern id in
- let text = self#string_of_cic_sequent sequent in
- (match father_hyp with
- | None -> None, [], Some text
- | Some hyp_name -> None, [ hyp_name, text ], None)
- | SelHyp (hyp_name, _ctxt) -> None, [ hyp_name, "%" ], None
+ | node :: _ -> self#tactic_text_pattern_of_node node
method private popup_contextual_menu time =
let menu = GMenu.menu () in
@@ -268,9 +280,13 @@ object (self)
GMenu.image_menu_item ?stock ?label ~packing:menu#append () in
let check = add_menu_item ~label:"Check" () in
let reductions_menu_item = GMenu.menu_item ~label:"βδιζ-reduce" () in
+ let tactics_menu_item = GMenu.menu_item ~label:"Apply tactic" () in
menu#append reductions_menu_item;
+ menu#append tactics_menu_item;
let reductions = GMenu.menu () in
+ let tactics = GMenu.menu () in
reductions_menu_item#set_submenu reductions;
+ tactics_menu_item#set_submenu tactics;
let normalize = add_menu_item ~menu:reductions ~label:"Normalize" () in
let reduce = add_menu_item ~menu:reductions ~label:"Reduce" () in
let simplify = add_menu_item ~menu:reductions ~label:"Simplify" () in
@@ -334,7 +350,8 @@ object (self)
(fun uri ->
let menu_item =
GMenu.menu_item ~label:uri ~packing:menu#append () in
- connect_menu_item menu_item (fun () -> f uri))
+ connect_menu_item menu_item
+ (fun () -> try f uri with Not_found -> assert false))
uris;
menu#popup ~button ~time)
@@ -412,14 +429,20 @@ object (self)
method private string_of_node ~(paste_kind:paste_kind) node =
if node#hasAttributeNS ~namespaceURI:helm_ns ~localName:xref_ds
then
- let id = id_of_node node in
- self#string_of_cic_sequent (self#sequent_of_id ~paste_kind id)
+ match paste_kind with
+ | `Pattern ->
+ let tactic_text_pattern = self#tactic_text_pattern_of_node node in
+ GrafiteAstPp.pp_tactic_pattern
+ ~term_pp:(fun s -> s) ~lazy_term_pp:(fun _ -> assert false)
+ tactic_text_pattern
+ | `Term -> self#tactic_text_of_node node
else string_of_dom_node node
method private string_of_cic_sequent cic_sequent =
let script = MatitaScript.current () in
let metasenv =
if script#onGoingProof () then script#proofMetasenv else [] in
+ (*
let _, (acic_sequent, _, _, ids_to_inner_sorts, _) =
Cic2acic.asequent_of_sequent metasenv cic_sequent in
let _, _, _, annterm = acic_sequent in
@@ -428,6 +451,9 @@ object (self)
let pped_ast = TermContentPres.pp_ast ast in
let markup = CicNotationPres.render ids_to_uris pped_ast in
BoxPp.render_to_string text_width markup
+ *)
+ ApplyTransformation.txt_of_cic_sequent_conclusion
+ text_width metasenv cic_sequent
method private pattern_of term context unsh_sequent =
let context_len = List.length context in
@@ -524,7 +550,8 @@ object (self)
ids_to_terms, ids_to_hypotheses, ids_to_father_ids,
Hashtbl.create 1, None));
if BuildTimeConf.debug then begin
- let name = "sequent_viewer.xml" in
+ let name =
+ "/tmp/sequent_viewer_" ^ string_of_int (Unix.getuid ()) ^ ".xml" in
HLog.debug ("load_sequent: dumping MathML to ./" ^ name);
ignore (domImpl#saveDocumentToFile ~name ~doc:mathml ())
end;
@@ -546,7 +573,8 @@ object (self)
self#thaw
| _ ->
if BuildTimeConf.debug then begin
- let name = "cic_browser.xml" in
+ let name =
+ "/tmp/cic_browser_" ^ string_of_int (Unix.getuid ()) ^ ".xml" in
HLog.debug ("cic_browser: dumping MathML to ./" ^ name);
ignore (domImpl#saveDocumentToFile ~name ~doc:mathml ())
end;
@@ -557,8 +585,8 @@ end
let tab_label meta_markup =
let rec aux =
function
- | `Current m -> sprintf "%s" (aux m)
| `Closed m -> sprintf "%s" (aux m)
+ | `Current m -> sprintf "%s" (aux m)
| `Shift (pos, m) -> sprintf "|%d: %s" pos (aux m)
| `Meta n -> sprintf "?%d" n
in
@@ -680,7 +708,8 @@ class sequentsViewer ~(notebook:GPack.notebook) ~(cicMathView:cicMathView) () =
~env:(fun depth tag (pos, sw) ->
let markup =
match depth, pos with
- | 0, _ -> `Current (render_switch sw)
+ | 0, 0 -> `Current (render_switch sw)
+ | 0, _ -> `Shift (pos, `Current (render_switch sw))
| 1, pos when Stack.head_tag stack = `BranchTag ->
`Shift (pos, render_switch sw)
| _ -> render_switch sw
@@ -760,12 +789,17 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
"^cic:/([^/]+/)*[^/]+\\.(con|ind|var)(#xpointer\\(\\d+(/\\d+)+\\))?$"
in
let dir_RE = Pcre.regexp "^cic:((/([^/]+/)*[^/]+(/)?)|/|)$" in
- let whelp_query_RE = Pcre.regexp "^\\s*whelp\\s+([^\\s]+)\\s+(.*)$" in
+ let metadata_RE = Pcre.regexp "^metadata:/(deps)/(forward|backward)/(.*)$" in
+ let whelp_query_RE = Pcre.regexp
+ "^\\s*whelp\\s+([^\\s]+)\\s+(\"|\\()(.*)(\\)|\")$"
+ in
+ let is_metadata txt = Pcre.pmatch ~rex:metadata_RE txt in
let is_whelp txt = Pcre.pmatch ~rex:whelp_RE txt in
let is_uri txt = Pcre.pmatch ~rex:uri_RE txt in
let is_dir txt = Pcre.pmatch ~rex:dir_RE txt in
let gui = get_gui () in
let (win: MatitaGuiTypes.browserWin) = gui#newBrowserWin () in
+ let gviz = LablGraphviz.graphviz ~packing:win#graphScrolledWin#add () in
let queries = ["Locate";"Hint";"Match";"Elim";"Instance"] in
let combo,_ = GEdit.combo_box_text ~strings:queries () in
let activate_combo_query input q =
@@ -775,17 +809,17 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
| h::_ when String.lowercase h = q' -> i
| _::tl -> aux (i+1) tl
in
+ win#queryInputText#set_text input;
combo#set_active (aux 0 queries);
- win#queryInputText#set_text input
in
let set_whelp_query txt =
let query, arg =
try
let q = Pcre.extract ~rex:whelp_query_RE txt in
- q.(1), q.(2)
- with Invalid_argument _ -> failwith "Malformed Whelp query"
+ q.(1), q.(3)
+ with Not_found -> failwith "Malformed Whelp query"
in
- activate_combo_query arg query
+ activate_combo_query arg query;
in
let toplevel = win#toplevel in
let mathView = cicMathView ~packing:win#scrolledBrowser#add () in
@@ -797,30 +831,52 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
[ "dir", GdkPixbuf.from_file (MatitaMisc.image_path "matita-folder.png");
"obj", GdkPixbuf.from_file (MatitaMisc.image_path "matita-object.png") ]
in
+ let b = (not (Helm_registry.get_bool "matita.debug")) in
let handle_error f =
try
f ()
with exn ->
- if not (Helm_registry.get_bool "matita.debug") then
+ if b then
fail (snd (MatitaExcPp.to_string exn))
else raise exn
in
let handle_error' f = (fun () -> handle_error (fun () -> f ())) in
let load_easter_egg = lazy (
- win#easterEggImage#set_file (MatitaMisc.image_path "meegg.png"))
+ win#browserImage#set_file (MatitaMisc.image_path "meegg.png"))
+ in
+ let load_coerchgraph () =
+ let str = CoercGraph.generate_dot_file () in
+ let filename, oc = Filename.open_temp_file "matita" ".dot" in
+ output_string oc str;
+ close_out oc;
+ gviz#load_graph_from_file filename;
+ HExtlib.safe_remove filename
in
object (self)
inherit scriptAccessor
(* Whelp bar queries *)
+ val mutable gviz_graph = MetadataDeps.DepGraph.dummy
+ val mutable gviz_uri = UriManager.uri_of_string "cic:/dummy.con";
+
+ val dep_contextual_menu = GMenu.menu ()
+
initializer
activate_combo_query "" "locate";
win#whelpBarComboVbox#add combo#coerce;
let start_query () =
- let query = String.lowercase (List.nth queries combo#active) in
- let input = win#queryInputText#text in
- let statement = "whelp " ^ query ^ " " ^ input ^ "." in
+ let query =
+ try
+ String.lowercase (List.nth queries combo#active)
+ with Not_found -> assert false in
+ let input = win#queryInputText#text in
+ let statement =
+ if query = "locate" then
+ "whelp " ^ query ^ " \"" ^ input ^ "\"."
+ else
+ "whelp " ^ query ^ " (" ^ input ^ ")."
+ in
(MatitaScript.current ())#advance ~statement ()
in
ignore(win#queryInputText#connect#activate ~callback:start_query);
@@ -852,11 +908,57 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
mathView#set_href_callback (Some (fun uri ->
handle_error (fun () ->
self#load (`Uri (UriManager.uri_of_string uri)))));
+ gviz#connect_href (fun button_ev attrs ->
+ let time = GdkEvent.Button.time button_ev in
+ let uri = List.assoc "href" attrs in
+ gviz_uri <- UriManager.uri_of_string uri;
+ match GdkEvent.Button.button button_ev with
+ | button when button = left_button -> self#load (`Uri gviz_uri)
+ | button when button = right_button ->
+ dep_contextual_menu#popup ~button ~time
+ | _ -> ());
+ connect_menu_item win#depGraphMenuItem (fun () ->
+ match self#currentCicUri with
+ | Some uri -> self#load (`Metadata (`Deps (`Fwd, uri)))
+ | None -> ());
+ connect_menu_item win#invDepGraphMenuItem (fun () ->
+ match self#currentCicUri with
+ | Some uri -> self#load (`Metadata (`Deps (`Back, uri)))
+ | None -> ());
+
+ (* fill dep graph contextual menu *)
+ let go_menu_item =
+ GMenu.image_menu_item ~label:"Browse it"
+ ~packing:dep_contextual_menu#append () in
+ let expand_menu_item =
+ GMenu.image_menu_item ~label:"Expand"
+ ~packing:dep_contextual_menu#append () in
+ let collapse_menu_item =
+ GMenu.image_menu_item ~label:"Collapse"
+ ~packing:dep_contextual_menu#append () in
+ dep_contextual_menu#append (go_menu_item :> GMenu.menu_item);
+ dep_contextual_menu#append (expand_menu_item :> GMenu.menu_item);
+ dep_contextual_menu#append (collapse_menu_item :> GMenu.menu_item);
+ connect_menu_item go_menu_item (fun () -> self#load (`Uri gviz_uri));
+ connect_menu_item expand_menu_item (fun () ->
+ MetadataDeps.DepGraph.expand gviz_uri gviz_graph;
+ self#redraw_gviz ~center_on:gviz_uri ());
+ connect_menu_item collapse_menu_item (fun () ->
+ MetadataDeps.DepGraph.collapse gviz_uri gviz_graph;
+ self#redraw_gviz ~center_on:gviz_uri ());
+
self#_load (`About `Blank);
toplevel#show ()
val mutable current_entry = `About `Blank
+ (** @return None if no object uri can be built from the current entry *)
+ method private currentCicUri =
+ match current_entry with
+ | `Uri uri
+ | `Metadata (`Deps (_, uri)) -> Some uri
+ | _ -> None
+
val model =
new MatitaGtkMisc.taggedStringListModel tags win#whelpResultTreeview
@@ -900,6 +1002,7 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
*)
method private _showMath = win#mathOrListNotebook#goto_page 0
method private _showList = win#mathOrListNotebook#goto_page 1
+ method private _showGviz = win#mathOrListNotebook#goto_page 3
method private back () =
try
@@ -915,15 +1018,20 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
* @param uri string *)
method private _load ?(force=false) entry =
handle_error (fun () ->
- if entry <> current_entry || entry = `About `Current_proof || force then
+ if entry <> current_entry || entry = `About `Current_proof || entry =
+ `About `Coercions || force then
begin
(match entry with
| `About `Current_proof -> self#home ()
| `About `Blank -> self#blank ()
| `About `Us -> self#egg ()
+ | `About `Coercions -> self#coerchgraph ()
| `Check term -> self#_loadCheck term
| `Cic (term, metasenv) -> self#_loadTermCic term metasenv
+ | `Development d -> self#_showDevelDeps d
| `Dir dir -> self#_loadDir dir
+ | `Metadata (`Deps ((`Fwd | `Back) as dir, uri)) ->
+ self#dependencies dir uri ()
| `Uri uri -> self#_loadUriManagerUri uri
| `Whelp (query, results) ->
set_whelp_query query;
@@ -944,6 +1052,31 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
win#mathOrListNotebook#goto_page 2;
Lazy.force load_easter_egg
+ method private redraw_gviz ?center_on () =
+ let tmpfile, oc = Filename.open_temp_file "matita" ".dot" in
+ let fmt = Format.formatter_of_out_channel oc in
+ MetadataDeps.DepGraph.render fmt gviz_graph;
+ close_out oc;
+ gviz#load_graph_from_file ~gviz_cmd:"tred | dot" tmpfile;
+ (match center_on with
+ | None -> ()
+ | Some uri -> gviz#center_on_href (UriManager.string_of_uri uri));
+ HExtlib.safe_remove tmpfile
+
+ method private dependencies direction uri () =
+ let dbd = LibraryDb.instance () in
+ let graph =
+ match direction with
+ | `Fwd -> MetadataDeps.DepGraph.direct_deps ~dbd uri
+ | `Back -> MetadataDeps.DepGraph.inverse_deps ~dbd uri in
+ gviz_graph <- graph; (** XXX check this for memory consuption *)
+ self#redraw_gviz ~center_on:uri ();
+ self#_showGviz
+
+ method private coerchgraph () =
+ load_coerchgraph ();
+ self#_showGviz
+
method private home () =
self#_showMath;
match self#script#grafite_status.proof_status with
@@ -982,6 +1115,16 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
win#browserUri#entry#set_text (MatitaTypes.string_of_entry entry);
current_entry <- entry
+ method private _showDevelDeps d =
+ match MatitamakeLib.development_for_name d with
+ | None -> ()
+ | Some devel ->
+ (match MatitamakeLib.dot_for_development devel with
+ | None -> ()
+ | Some fname ->
+ gviz#load_graph_from_file ~gviz_cmd:"tred | dot" fname;
+ self#_showGviz)
+
method private _loadObj obj =
(* showMath must be done _before_ loading the document, since if the
* widget is not mapped (hidden by the notebook) the document is not
@@ -1008,19 +1151,31 @@ class cicBrowser_impl ~(history:MatitaTypes.mathViewer_entry MatitaMisc.history)
(** this is what the browser does when you enter a string an hit enter *)
method loadInput txt =
+ let parse_metadata s =
+ let subs = Pcre.extract ~rex:metadata_RE s in
+ let uri = UriManager.uri_of_string ("cic:/" ^ subs.(3)) in
+ match subs.(1), subs.(2) with
+ | "deps", "forward" -> `Deps (`Fwd, uri)
+ | "deps", "backward" -> `Deps (`Back, uri)
+ | _ -> assert false
+ in
let txt = HExtlib.trim_blanks txt in
+ (* (* ZACK: what the heck? *)
let fix_uri txt =
UriManager.string_of_uri
(UriManager.strip_xpointer (UriManager.uri_of_string txt))
in
+ *)
if is_whelp txt then begin
set_whelp_query txt;
(MatitaScript.current ())#advance ~statement:(txt ^ ".") ()
end else begin
let entry =
match txt with
- | txt when is_uri txt -> `Uri (UriManager.uri_of_string (fix_uri txt))
+ | txt when is_uri txt ->
+ `Uri (UriManager.uri_of_string ((*fix_uri*) txt))
| txt when is_dir txt -> `Dir (MatitaMisc.normalize_dir txt)
+ | txt when is_metadata txt -> `Metadata (parse_metadata txt)
| txt ->
(try
MatitaTypes.entry_of_string txt