X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FsearchEngine%2FsearchEngine.ml;h=f7fae9481e6d0ac093705fa5fd21f7f50fba5dd7;hb=fde0ad77237a2fbdfb5621d5b5085fe7c82e3f92;hp=aaa5f48fa34af5210bd8fd43bf2175d684bbdc98;hpb=19802b6487148ac232b560b43f131ffa679e4ee8;p=helm.git diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml index aaa5f48fa..f7fae9481 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) @@ -177,44 +175,25 @@ let contype = "Content-Type", "text/html";; (* SEARCH ENGINE functions *) -let refine_constraints ((constr_obj:T.r_obj list), (constr_rel:T.r_rel list), (constr_sort:T.r_sort list)) = - function - "/searchPattern" -> - U.universe_for_search_pattern, - (constr_obj, constr_rel, constr_sort), - (Some constr_obj, Some constr_rel, Some constr_sort) - | "/matchConclusion" -> - let constr_obj' = - List.map - (function (pos, uri) -> U.set_full_position pos None, uri) - (List.filter - (function (pos, _) -> U.is_conclusion pos) - constr_obj) - in - U.universe_for_match_conclusion, - (*CSC: we must select the must constraints here!!! *) - (constr_obj',[],[]),(Some constr_obj', None, None) - | _ -> assert false -;; - 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) - | req_path -> - let must = MQueryLevels2.get_constraints term in - refine_constraints must req_path + | "/locateInductivePrinciple" -> + None, + (CGLocateInductive.get_constraints term), + (None,None,None) + | "/searchPattern" -> + let constr_obj, constr_rel, constr_sort = + CGSearchPattern.get_constraints term in + (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 + (Some CGMatchConclusion.universe), + (List.nth list_of_must block, [], []), (Some only, None, None) + | _ -> assert false ;; (* @@ -312,6 +291,14 @@ let callback (req: Http_types.request) outchan = let result = MQueryInterpreter.execute mqi_handle query in C.close mqi_handle; Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan + | "/unreferred" -> + let mqi_handle = C.init mqi_flags debug_print in + let target = req#param "target" in + let source = req#param "source" in + let query = G.unreferred target source in + let result = MQueryInterpreter.execute mqi_handle query in + C.close mqi_handle; + Http_daemon.respond ~headers:[contype] ~body:(pp_result result) outchan | "/getpage" -> (* TODO implement "is_permitted" *) (let is_permitted _ = true in @@ -592,7 +579,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 ;