- output_html outputhtml (
- try
- match Str.split (Str.regexp "[ \t]+") input with
- | [] -> ""
- | head :: tail ->
- inputt#delete_text 0 inputlen;
- Mquery.locate head
- with
- e -> "<h1 color=\"red\">" ^ Printexc.to_string e ^ "</h1>"
- )
-;;
-
-let backward rendering_window () =
- let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
- let inputt = (rendering_window#inputt : GEdit.text) in
- let inputlen = inputt#length in
- let input = inputt#get_chars 0 inputlen in
- let level = int_of_string input in
- let metasenv =
- match !ProofEngine.proof with
- None -> assert false
- | Some (_,metasenv,_,_) -> metasenv
- in
- let result =
- match !ProofEngine.goal with
- | None -> ""
- | Some metano ->
- let (_,_,ty) =
- List.find (function (m,_,_) -> m=metano) metasenv
- in
- Mquery.backward ty level
- in
- output_html outputhtml result
+ try
+ match Str.split (Str.regexp "[ \t]+") input with
+ [] -> ()
+ | head :: tail ->
+ inputt#delete_text 0 inputlen ;
+ let result = MQueryGenerator.locate head in
+ let uris =
+ List.map
+ (function uri,_ -> wrong_xpointer_format_from_wrong_xpointer_format' uri)
+ result in
+ let html = (" <h1>Locate Query: </h1><pre>" ^ get_last_query result ^ "</pre>") in
+ output_html outputhtml html ;
+ let uri' = user_uri_choice uris in
+ ignore ((inputt#insert_text uri') ~pos:0)
+ with
+ e ->
+ output_html outputhtml
+ ("<h1 color=\"red\">" ^ Printexc.to_string e ^ "</h1>")
+;;
+
+let searchPattern rendering_window () =
+ let outputhtml = (rendering_window#outputhtml : GHtml.xmhtml) in
+ let inputt = (rendering_window#inputt : GEdit.text) in
+ let inputlen = inputt#length in
+ let input = inputt#get_chars 0 inputlen in
+ let level = int_of_string input in
+ let metasenv =
+ match !ProofEngine.proof with
+ None -> assert false
+ | Some (_,metasenv,_,_) -> metasenv
+ in
+ try
+ match !ProofEngine.goal with
+ None -> ()
+ | Some metano ->
+ let (_, ey ,ty) = List.find (function (m,_,_) -> m=metano) metasenv in
+ let result = MQueryGenerator.searchPattern metasenv ey ty level in
+ let uris =
+ List.map
+ (function uri,_ -> wrong_xpointer_format_from_wrong_xpointer_format' uri)
+ result in
+ let html =
+ " <h1>Backward Query: </h1>" ^
+ " <h2>Levels: </h2> " ^
+ MQueryGenerator.string_of_levels
+ (MQueryGenerator.levels_of_term metasenv ey ty) "<br>" ^
+ " <pre>" ^ get_last_query result ^ "</pre>"
+ in
+ output_html outputhtml html ;
+ let uris',exc =
+ let rec filter_out =
+ function
+ [] -> [],""
+ | uri::tl ->
+ let tl',exc = filter_out tl in
+ try
+ if ProofEngine.can_apply (term_of_uri uri) then
+ uri::tl',exc
+ else
+ tl',exc
+ with
+ e ->
+ let exc' =
+ "<h1 color=\"red\"> ^ Exception raised trying to apply " ^
+ uri ^ ": " ^ Printexc.to_string e ^ " </h1>" ^ exc
+ in
+ tl',exc'
+ in
+ filter_out uris
+ in
+ let html' =
+ " <h1>Objects that can actually be applied: </h1> " ^
+ String.concat "<br>" uris' ^ exc ^
+ " <h1>Number of false matches: " ^
+ string_of_int (List.length uris - List.length uris') ^ "</h1>" ^
+ " <h1>Number of good matches: " ^
+ string_of_int (List.length uris') ^ "</h1>"
+ in
+ output_html outputhtml html' ;
+ let uri' = user_uri_choice uris' in
+ inputt#delete_text 0 inputlen ;
+ ignore ((inputt#insert_text uri') ~pos:0)
+ with
+ e ->
+ output_html outputhtml
+ ("<h1 color=\"red\">" ^ Printexc.to_string e ^ "</h1>")
+;;