X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FsearchEngine%2FsearchEngine.ml;h=c42c01043f081b01251b8566c73caf009abf8c2f;hb=4167cea65ca58897d1a3dbb81ff95de5074700cc;hp=d8af6b10e566bb8e3e2c46c9881e6adaf8edaac1;hpb=16065a413f4be50761d73be9dca3953ff9bfc1eb;p=helm.git

diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml
index d8af6b10e..c42c01043 100644
--- a/helm/searchEngine/searchEngine.ml
+++ b/helm/searchEngine/searchEngine.ml
@@ -36,14 +36,14 @@ exception Invalid_action of string  (* invalid action for "/search" method *)
   (** raised by elim when a MutInd is required but not found *)
 exception Not_a_MutInd
 
-let daemon_name = "Moogle"
-let configuration_file = "/projects/helm/etc/moogle.conf.xml"
+let daemon_name = "Whelp"
+let configuration_file = "/projects/helm/etc/whelp.conf.xml"
 
 let placeholders = [
   "ACTION"; "ADVANCED"; "ADVANCED_CHECKED"; "CHOICES"; "CURRENT_CHOICES";
   "EXPRESSION"; "ID"; "IDEN"; "ID_TO_URIS"; "INTERPRETATIONS";
   "INTERPRETATIONS_LABELS"; "MSG"; "NEW_ALIASES"; "NEXT_LINK"; "NO_CHOICES";
-  "PAGE"; "PAGES"; "PREV_LINK"; "QUERY_KIND"; "QUERY_SUMMARY"; "RESULTS";
+  "PAGE"; "PAGES"; "PAGELIST"; "PREV_LINK"; "QUERY_KIND"; "QUERY_SUMMARY"; "RESULTS";
   "SEARCH_ENGINE_URL"; "SIMPLE_CHECKED"; "TITLE";
 ]
 
@@ -103,7 +103,8 @@ let javascript_quote s =
 let string_tail s =
   let len = String.length s in
   String.sub s 1 (len-1)
-let nonvar s =
+let nonvar uri =
+  let s = UriManager.string_of_uri uri in
   let len = String.length s in
   let suffix = String.sub s (len-4) 4 in
   not (suffix  = ".var")
@@ -118,7 +119,9 @@ let add_param_substs params =
       params)
 
 let page_RE = Pcre.regexp "&param\\.page=\\d+"
-let identifier_RE = Pcre.regexp "^\\s*\\w+\\s*$"
+let identifier_RE = Pcre.regexp "^\\s*(\\w|')+\\s*$"
+let qualified_mutind_RE =
+ Pcre.regexp "^\\s*cic:(/(\\w|')+)+\\.ind#xpointer\\(1/\\d+\\)\\s*$"
 
 let query_kind_of_req (req: Http_types.request) =
   match req#path with
@@ -126,6 +129,7 @@ let query_kind_of_req (req: Http_types.request) =
   | "/hint" -> "Hint"
   | "/locate" -> "Locate"
   | "/elim" -> "Elim"
+  | "/instance" -> "Instance"
   | _ -> ""
 
   (* given a uri with a query part in input try to find in it a string
@@ -142,8 +146,16 @@ let patch_param param_name param_value url =
   (** HTML encoding, e.g.: "<" -> "&lt;" *)
 let html_encode = Netencoding.Html.encode_from_latin1
 
+let fold_n_to_m f n m acc =
+ let rec aux acc =
+  function
+     i when i <= m -> aux (f i acc) (i + 1)
+   | _ -> acc
+ in
+  aux acc n
+
 let send_results results
-  ?(id_to_uris = CicTextualParser2.EnvironmentP3.of_string "") 
+  ?(id_to_uris = DisambiguateTypes.empty_environment) 
    (req: Http_types.request) outchan
   =
   let query_kind = query_kind_of_req req in
@@ -178,9 +190,28 @@ let send_results results
             results_no / results_per_page + 1
         in
         let pages = if pages = 0 then 1 else pages in
+        let additional_pages = 3 in
         let (summary, results) = MooglePp.theory_of_result page results in
         [ tag "PAGE", string_of_int page;
-          tag "PAGES", string_of_int pages;
+          tag "PAGES", string_of_int pages ^ " Pages";
+          tag "PAGELIST",
+          (let inf = page - additional_pages in
+           let sup = page + additional_pages in
+           let superinf = inf - (sup - pages) in
+           let supersup = sup + (1 - inf) in
+           let n,m =
+            if inf >= 1 && sup <= pages then
+             inf,sup
+            else if inf < 1 then
+             1, (if supersup <= pages then supersup else pages)
+            else (* sup > pages *)
+             (if superinf >= 1 then superinf else 1),pages
+           in
+            fold_n_to_m
+             (fun n acc -> acc ^ " " ^
+                          (if n = page then string_of_int n
+                           else page_link (string_of_int n) n))
+             n m "");
           tag "PREV_LINK", (if page > 1 then page_link "Prev" (page-1) else "");
           tag "NEXT_LINK",
             (if page < pages then page_link "Next" (page+1) else "");
@@ -189,7 +220,8 @@ let send_results results
           tag "RESULTS", results ]
     | `Error msg ->
         [ tag "PAGE", "1";
-          tag "PAGES", "1";
+          tag "PAGES", "1 Page";
+          tag "PAGELIST", "";
           tag "PREV_LINK", "";
           tag "NEXT_LINK", "";
           tag "QUERY_KIND", query_kind;
@@ -216,9 +248,7 @@ let send_results results
   in
   iter_file
     (fun line ->
-      let new_aliases =
-        CicTextualParser2.EnvironmentP3.to_string id_to_uris
-      in
+      let new_aliases = DisambiguatePp.pp_environment id_to_uris in
       let processed_line =
         apply_substs
           (* CSC: Bug here: this is a string, not an array! *)
@@ -232,7 +262,9 @@ let send_results results
 let exec_action dbd (req: Http_types.request) outchan =
   let term_str = req#param "expression" in
   try
-    if req#path = "/elim" && not (Pcre.pmatch ~rex:identifier_RE term_str) then
+    if req#path = "/elim" &&
+     not (Pcre.pmatch ~rex:identifier_RE term_str ||
+          Pcre.pmatch ~rex:qualified_mutind_RE term_str) then
       raise Not_a_MutInd;
     let (context, metasenv) = ([], []) in
     let id_to_uris_raw = 
@@ -250,14 +282,17 @@ let exec_action dbd (req: Http_types.request) outchan =
              | id::tail when id<>"" ->
                  (fun id' ->
                     if id = id' then
-                      Some (List.map (fun u -> Netencoding.Url.decode u) tail)
+                      Some (List.map 
+                        (fun u -> UriManager.uri_of_string
+                          (Netencoding.Url.decode u)) 
+                        tail)
                     else
                       f id')
              | _ -> failwith "Can't parse choices")
         (fun _ -> None)
         choices
     in
-    let id_to_uris = CicTextualParser2.EnvironmentP3.of_string id_to_uris_raw in
+    let id_to_uris = DisambiguatePp.parse_environment id_to_uris_raw in
     let id_to_choices =
       try
         parse_choices (req#param "choices")
@@ -274,7 +309,7 @@ let exec_action dbd (req: Http_types.request) outchan =
       struct
         let interactive_user_uri_choice ~selection_mode ?ok
           ?enable_button_for_non_vars ~(title: string) ~(msg: string)
-          ~(id: string) (choices: string list)
+          ~(id: string) (choices: UriManager.uri list)
         =
           match id_to_choices id with
           | Some choices -> choices
@@ -320,10 +355,11 @@ let exec_action dbd (req: Http_types.request) outchan =
       end
     in
     let module Disambiguate' = Disambiguate.Make(Chat) in
-    let ast = CicTextualParser2.parse_term (Stream.of_string term_str) in
+    let ast = Grammar.Entry.parse CicNotationParser.term (Stream.of_string term_str) in
     let (id_to_uris, metasenv, term) =
       match
-        Disambiguate'.disambiguate_term dbd context metasenv ast id_to_uris
+        Disambiguate'.disambiguate_term ~dbd ~context ~metasenv
+          ~aliases:id_to_uris ast
       with
       | [id_to_uris,metasenv,term,_] -> id_to_uris,metasenv,term
       | _ -> assert false
@@ -331,6 +367,7 @@ let exec_action dbd (req: Http_types.request) outchan =
     let uris =
       match req#path with
       | "/match" -> MetadataQuery.match_term ~dbd term
+      | "/instance" -> MetadataQuery.instance ~dbd term
       | "/hint" ->
           let status = ProofEngineTypes.initial_status term metasenv in
           let intros = PrimitiveTactics.intros_tac () in
@@ -338,18 +375,19 @@ let exec_action dbd (req: Http_types.request) outchan =
           (match subgoals with
           | proof, [goal] ->
               let (uri,metasenv,bo,ty) = proof in
-              List.map fst (MetadataQuery.hint ~dbd (proof, goal))
+              List.map fst (MetadataQuery.experimental_hint ~dbd (proof, goal))
           | _ -> assert false)
       | "/elim" ->
           let uri =
             match term with
             | Cic.MutInd (uri, typeno, _) ->
-                UriManager.string_of_uriref (uri, [typeno])
+                UriManager.uri_of_uriref uri typeno None 
             | _ -> raise Not_a_MutInd
           in
           MetadataQuery.elim ~dbd uri
       | _ -> assert false
     in
+    let uris = List.map UriManager.string_of_uri uris in
     send_results ~id_to_uris (`Results uris) req outchan
   with
   | Not_a_MutInd ->
@@ -405,10 +443,12 @@ let callback dbd (req: Http_types.request) outchan =
           send_results (`Results []) req outchan
         else begin
           let results = MetadataQuery.locate ~dbd expression in
+          let results = List.map UriManager.string_of_uri results in
           send_results (`Results results) req outchan
         end
     | "/hint"
     | "/elim"
+    | "/instance"
     | "/match" -> exec_action dbd req outchan
     | invalid_request ->
         Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request))
@@ -418,7 +458,7 @@ let callback dbd (req: Http_types.request) outchan =
   | Chat_unfinished -> ()
   | Http_types.Param_not_found attr_name ->
       bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan
-  | CicTextualParser2.Parse_error (_, msg) ->
+  | CicNotationParser.Parse_error (_, msg) ->
       send_results (`Error (MooglePp.pp_error "Parse error" msg)) req outchan
   | Unbound_identifier id ->
       send_results (`Error (MooglePp.pp_error "Unbound identifier" id)) req
@@ -431,7 +471,7 @@ let callback dbd (req: Http_types.request) outchan =
 
 let restore_environment () =
   match
-    Helm_registry.get_opt Helm_registry.get "search_engine.environment_dump"
+    Helm_registry.get_opt Helm_registry.string "search_engine.environment_dump"
   with
   | None -> ()
   | Some fname ->
@@ -441,6 +481,10 @@ let restore_environment () =
       close_in ic;
       printf "done!\n"; flush stdout
 
+let read_notation () =
+ CicNotation.load_notation (Helm_registry.get "search_engine.notations");
+ CicNotation.load_notation (Helm_registry.get "search_engine.interpretations")
+
 let _ =
   printf "%s started and listening on port %d\n" daemon_name port;
   printf "Current directory is %s\n" (Sys.getcwd ());
@@ -455,6 +499,7 @@ let _ =
       ()
   in
   restore_environment ();
+  read_notation ();
   Http_daemon.start' ~port (callback dbd);
   printf "%s is terminating, bye!\n" daemon_name