X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;ds=sidebyside;f=daemons%2Fwhelp%2FsearchEngine.ml;h=fc49116196d4cb96ff0518d43527e76ab27ef753;hb=ac97d2ee5a0e23837ee0c479772ac10866a95aaa;hp=26c1def3e60c6c7cbb4cd405829136993420f7b4;hpb=28eef5b98d64d50e0c593a538f5eacb6279d395b;p=helm.git diff --git a/daemons/whelp/searchEngine.ml b/daemons/whelp/searchEngine.ml index 26c1def3e..fc4911619 100644 --- a/daemons/whelp/searchEngine.ml +++ b/daemons/whelp/searchEngine.ml @@ -357,7 +357,8 @@ let exec_action dbd (req: Http_types.request) outchan = end in let module Disambiguate' = Disambiguate.Make(Chat) in - let ast = Grammar.Entry.parse CicNotationParser.term (Stream.of_string term_str) in + let ast = + CicNotationParser.parse_term (Ulexing.from_utf8_string term_str) in let (id_to_uris, metasenv, term) = match Disambiguate'.disambiguate_term ~dbd ~context ~metasenv @@ -402,7 +403,7 @@ let exec_action dbd (req: Http_types.request) outchan = ^ " type"))) req outchan -let callback dbd (req: Http_types.request) outchan = +let callback (dbd, (req: Http_types.request), outchan) = try debug_print (sprintf "Received request: %s" req#path); (match req#path with @@ -466,6 +467,11 @@ let callback dbd (req: Http_types.request) outchan = bad_request (sprintf "Parameter '%s' is missing" attr_name) outchan | CicNotationParser.Parse_error msg -> send_results (`Error (MooglePp.pp_error "Parse error" msg)) req outchan + | Stdpp.Exc_located (floc, Stream.Error msg) -> + send_results (`Error (MooglePp.pp_error "Parse error" msg)) req outchan + | Stdpp.Exc_located (floc, exn) -> + let msg = Printexc.to_string exn in + send_results (`Error (MooglePp.pp_error "Unknown error" msg)) req outchan | Unbound_identifier id -> send_results (`Error (MooglePp.pp_error "Unbound identifier" id)) req outchan @@ -475,6 +481,11 @@ let callback dbd (req: Http_types.request) outchan = let msg = MooglePp.pp_error "Uncaught exception" exn_string in send_results (`Error msg) req outchan +let callback dbd req ch = + HExtlib.finally + (fun () -> try close_out ch with Sys_error _ -> ()) + callback (dbd, req, ch) + let restore_environment () = match Helm_registry.get_opt Helm_registry.string "search_engine.environment_dump" @@ -488,11 +499,10 @@ let restore_environment () = printf "done!\n"; flush stdout let read_notation () = - let _ = assert false in () - (* - CicNotation.load_notation (Helm_registry.get "search_engine.notations"); - CicNotation.load_notation (Helm_registry.get "search_engine.interpretations") - *) + ignore (CicNotation2.load_notation ~include_paths:[] + (Helm_registry.get "search_engine.notations")); + ignore (CicNotation2.load_notation ~include_paths:[] + (Helm_registry.get "search_engine.interpretations")) let _ = printf "%s started and listening on port %d\n" daemon_name port; @@ -509,6 +519,7 @@ let _ = in restore_environment (); read_notation (); - Http_daemon.start' ~port (callback dbd); + let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) () in + Http_daemon.main d_spec; printf "%s is terminating, bye!\n" daemon_name