X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FsearchEngine%2FsearchEngine.ml;h=a140666aca5d3d2434f78bcd6d3bac75592ed246;hb=ac0a12080b434bf0daafc08e9da240eb57f47280;hp=e4e33c629c4f808204dd2b48dcb03057fc6b8240;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff;p=helm.git diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index e4e33c629..a140666ac 100644 --- a/helm/searchEngine/searchEngine.ml +++ b/helm/searchEngine/searchEngine.ml @@ -155,8 +155,6 @@ let (title_tag_RE, choices_tag_RE, msg_tag_RE, id_to_uris_RE, id_RE, Pcre.regexp "@VARIABLES_INITIALIZATION@") let server_and_port_url_RE = Pcre.regexp "^http://([^/]+)/.*$" -exception NotAnInductiveDefinition - let port = try int_of_string (Sys.getenv port_env_var) @@ -180,29 +178,20 @@ let contype = "Content-Type", "text/html";; let get_constraints term = function | "/locateInductivePrinciple" -> - let uri = - match term with - Cic.MutInd (uri,t,_) -> MQueryUtil.string_of_uriref (uri,[t]) - | _ -> raise NotAnInductiveDefinition - in - let constr_obj = - [(`InHypothesis, uri); (`MainHypothesis (Some 0), uri)] - in - let constr_rel = [`MainConclusion None] in - let constr_sort = [(`MainHypothesis (Some 1), T.Prop)] in - U.universe_for_search_pattern, - (constr_obj, constr_rel, constr_sort), (None,None,None) + None, + (CGLocateInductive.get_constraints term), + (None,None,None) | "/searchPattern" -> let constr_obj, constr_rel, constr_sort = CGSearchPattern.get_constraints term in - U.universe_for_search_pattern, - (constr_obj, constr_rel, constr_sort), - (Some constr_obj, Some constr_rel, Some constr_sort) + (Some CGSearchPattern.universe), + (constr_obj, constr_rel, constr_sort), + (Some constr_obj, Some constr_rel, Some constr_sort) | "/matchConclusion" -> let list_of_must, only = CGMatchConclusion.get_constraints [] [] term in (* FG: there is no way to choose the block number ***************************) let block = pred (List.length list_of_must) in - U.universe_for_match_conclusion, + (Some CGMatchConclusion.universe), (List.nth list_of_must block, [], []), (Some only, None, None) | _ -> assert false ;; @@ -356,7 +345,7 @@ let callback (req: Http_types.request) outchan = if List.mem server_and_port valid_servers then Http_daemon.respond ~headers:["Content-Type", "text/html"] - ~body:(Http_client.Convenience.http_get url) + ~body:(Http_client.http_get url) outchan else Http_daemon.respond @@ -424,7 +413,16 @@ List.iter (fun u -> prerr_endline ("<" ^ Netencoding.Url.decode u ^ ">")) tail; let set_metasenv metasenv = CicTextualParser0.metasenv := metasenv - let output_html = prerr_endline + let output_html ?(append_NL = true) html_msg = + let rec collect_string = function + | `BR -> "\n" + | `T s -> s + | `L tags -> String.concat "" (List.map collect_string tags) + in + match html_msg with + | `Error msg | `Msg msg -> + (if append_NL then prerr_endline else prerr_string) + (collect_string msg ^ (if append_NL then "\n" else "")) let interactive_user_uri_choice ~selection_mode ?ok @@ -437,7 +435,7 @@ List.iter (fun u -> prerr_endline ("<" ^ Netencoding.Url.decode u ^ ">")) tail; let msg = Pcre.replace ~pat:"\'" ~templ:"\\\'" msg in (match selection_mode with | `SINGLE -> assert false - | `EXTENDED -> + | `MULTIPLE -> Http_daemon.send_basic_headers ~code:200 outchan ; Http_daemon.send_CRLF outchan ; iter_file @@ -590,7 +588,7 @@ List.iter (fun u -> prerr_endline ("<" ^ Netencoding.Url.decode u ^ ">")) tail; raise Chat_unfinished) in let query = - G.query_of_constraints (Some universe) must'' only' + G.query_of_constraints universe must'' only' in let results = MQueryInterpreter.execute mqi_handle query in Http_daemon.send_basic_headers ~code:200 outchan ;