ocaml 3.09 transition

[helm.git] / helm / searchEngine / searchEngine.ml

diff --git a/helm/searchEngine/searchEngine.ml b/helm/searchEngine/searchEngine.ml
index dcaee2466dc13a0c4a61c22d0de3ff1c5ee45d27..c42c01043f081b01251b8566c73caf009abf8c2f 100644 (file)
--- a/helm/searchEngine/searchEngine.ml
+++ b/helm/searchEngine/searchEngine.ml
@@ -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")
@@ -154,7 +155,7 @@ let fold_n_to_m f n m acc =
   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
@@ -247,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! *)
@@ -283,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")
@@ -307,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
@@ -353,7 +355,7 @@ 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
@@ -379,12 +381,13 @@ let exec_action dbd (req: Http_types.request) outchan =
           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 ->
@@ -440,6 +443,7 @@ 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"
@@ -454,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
@@ -477,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 ());
@@ -491,6 +499,7 @@ let _ =
       ()
   in
   restore_environment ();
+  read_notation ();
   Http_daemon.start' ~port (callback dbd);
   printf "%s is terminating, bye!\n" daemon_name