Merge branch 'change-gen-service-code-generation-strategy' of https:/…

…/github.com/gasche/ocaml-uri into gasche-silence-warnings

config/gen_services.ml

@@ -51,46 +51,53 @@ let _ =
         |"tcp" ->
           List.iter (fun svc ->
             hashtbl_add_list tcp_ports svc port;
-            hashtbl_add_list ports_tcp port ("\""^svc^"\"");
+            hashtbl_add_list ports_tcp port svc;
             Hashtbl.replace tcp_services svc ()
           ) (svc::aliases)
         |"udp" ->
           List.iter (fun svc ->
             hashtbl_add_list udp_ports svc port;
-            hashtbl_add_list ports_udp port ("\""^svc^"\"");
+            hashtbl_add_list ports_udp port svc;
             Hashtbl.replace udp_services svc ();
           ) (svc::aliases)
         |"ddp" | "sctp" | "divert" -> ()
         |x -> failwith ("unknown proto " ^ x)
       )
   done with End_of_file -> ());
+  let print_keys quote ppf table =
+    iter (fun k _v -> fprintf ppf ("%s; ") (quote k)) table in
+  let print_values quote ppf table =
+    iter (fun _k v -> fprintf ppf "[ %s ]; "
+             (String.concat "; " (List.map quote !v))) table in
+  let quote_string s = sprintf "%S" s in
   printf "(* Autogenerated by gen_services.ml, do not edit directly *)\n";
-  printf "let tcp_port_of_service = function\n";
-  iter (fun k v ->
-   printf "  |\"%s\" -> [%s]\n" k (String.concat ";" (List.map string_of_int !v))
-  ) tcp_ports;
-  printf "  |_ -> []\n\n";
-   printf "let udp_port_of_service = function\n";
-  iter (fun k v ->
-   printf "  |\"%s\" -> [%s]\n" k (String.concat ";" (List.map string_of_int !v))
-  ) udp_ports;
-  printf "  |_ -> []\n\n";
-  printf "let service_of_tcp_port = function\n";
-  iter (fun k v ->
-   printf "  |%d -> [%s]\n" k (String.concat ";" !v)
-  ) ports_tcp;
-  printf "  |_ -> []\n\n";
-   printf "let service_of_udp_port = function\n";
-  iter (fun k v ->
-   printf "  |%d -> [%s]\n" k (String.concat ";" !v)
-  ) ports_udp;
-  let tcp_services = Hashtbl.fold (fun k () a -> ("\""^k^"\"") :: a) tcp_services [] in
-  let udp_services = Hashtbl.fold (fun k () a -> ("\""^k^"\"") :: a) udp_services [] in
-  printf "  |_ -> []\n\n";
-  printf "let known_tcp_services =\n";
-  printf "  [ %s ]\n\n" (String.concat ";" tcp_services);
-  printf "let known_udp_services =\n";
-  printf "  [ %s ]\n\n" (String.concat ";" udp_services);
+
+  printf "let tcp_port_of_service_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys quote_string) tcp_ports
+    (print_values string_of_int) tcp_ports;
+
+  printf "let udp_port_of_service_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys quote_string) udp_ports
+    (print_values string_of_int) udp_ports;
+
+  printf "let service_of_tcp_port_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys string_of_int) ports_tcp
+    (print_values quote_string) ports_tcp;
+
+  printf "let service_of_udp_port_tables = (\n  [| %a |],\n  [| %a |]\n)\n\n"
+    (print_keys string_of_int) ports_udp
+    (print_values quote_string) ports_udp;
+
+  let hashset_elems table =
+    Hashtbl.fold (fun k () a -> quote_string k :: a) table []
+    |> List.sort String.compare
+    |> String.concat "; "
+  in
+  printf "let known_tcp_services =\n  [ %s ]\n\n"
+    (hashset_elems tcp_services);
+  printf "let known_udp_services =\n [ %s ]\n\n"
+    (hashset_elems udp_services);
+
   printf "let known_services = [\n";
   printf "  (\"tcp\", known_tcp_services);\n";
   printf "  (\"udp\", known_udp_services) ]\n\n";

etc/uri_services_raw.ml

@@ -1,3 +1,44 @@
+let search_string keys k =
+  let rec loop keys k low high =
+    if low > high then (-1)
+    else begin
+      let mid = (high + low) / 2 in
+      let diff = String.compare k keys.(mid) in
+      if diff < 0 then loop keys k low (mid - 1)
+      else if diff > 0 then loop keys k (mid + 1) high
+      else mid
+    end
+  in loop keys k 0 (Array.length keys - 1)
+
+let search_int keys k =
+  let rec loop keys k low high =
+    if low > high then (-1)
+    else begin
+      let mid = (high + low) / 2 in
+      let diff = k - keys.(mid) in
+      if diff < 0 then loop keys k low (mid - 1)
+      else if diff > 0 then loop keys k (mid + 1) high
+      else mid
+    end
+  in loop keys k 0 (Array.length keys - 1)
+
+let lookup search (keys, values) k =
+  let i = search keys k in
+  if i < 0 then []
+  else values.(i)
+
+let service_of_tcp_port p =
+  lookup search_int service_of_tcp_port_tables p
+
+let service_of_udp_port p =
+  lookup search_int service_of_udp_port_tables p
+
+let tcp_port_of_service s =
+  lookup search_string tcp_port_of_service_tables s
+
+let udp_port_of_service s =
+  lookup search_string udp_port_of_service_tables s
+
 let port_of_uri ?default lookupfn uri =
   match Uri.port uri with
   |Some _port as x -> x