Replace Hashtbl.find with Hashtbl.find_opt in trivial cases

This avoids two traversals in the cases where Hashtbl.mem is used
right before Hashtbl.find: avoiding two traversals,
possible data races and the possibility where one
would be changed without the other, introducing bugs.

Additionally, it handles failure explicitly where it wasn't
handled before, and moves from exception handling to matching on options
resulting in intentions becoming clearer.

This commit only changes trivial cases where little refactoring was
necessary.

Signed-off-by: Andrii Sultanov <[email protected]>

configure.ml

@@ -84,11 +84,12 @@ let () =
   in
   List.iter print_endline lines ;
   (* Expand @LIBEXEC@ in udev rules *)
-  try
-    let xenopsd_libexecdir = Hashtbl.find config "XENOPSD_LIBEXECDIR" in
-    expand "@LIBEXEC@" xenopsd_libexecdir "ocaml/xenopsd/scripts/vif.in"
-      "ocaml/xenopsd/scripts/vif" ;
-    expand "@LIBEXEC@" xenopsd_libexecdir
-      "ocaml/xenopsd/scripts/xen-backend.rules.in"
-      "ocaml/xenopsd/scripts/xen-backend.rules"
-  with Not_found -> failwith "xenopsd_libexecdir not set"
+  match Hashtbl.find_opt config "XENOPSD_LIBEXECDIR" with
+  | Some xenopsd_libexecdir ->
+      expand "@LIBEXEC@" xenopsd_libexecdir "ocaml/xenopsd/scripts/vif.in"
+        "ocaml/xenopsd/scripts/vif" ;
+      expand "@LIBEXEC@" xenopsd_libexecdir
+        "ocaml/xenopsd/scripts/xen-backend.rules.in"
+        "ocaml/xenopsd/scripts/xen-backend.rules"
+  | None ->
+      failwith "xenopsd_libexecdir not set"

ocaml/database/db_backend.ml

@@ -104,8 +104,5 @@ let is_session_registered session =
 
 let get_registered_database session =
   with_lock db_registration_mutex (fun () ->
-      if Hashtbl.mem foreign_databases session then
-        Some (Hashtbl.find foreign_databases session)
-      else
-        None
+      Hashtbl.find_opt foreign_databases session
   )

ocaml/database/db_conn_store.ml

@@ -41,12 +41,14 @@ let read_db_connections () = !db_connections
 let with_db_conn_lock db_conn f =
   let db_conn_m =
     with_lock db_conn_locks_m (fun () ->
-        try Hashtbl.find db_conn_locks db_conn
-        with _ ->
-          (* If we don't have a lock already for this connection then go make one dynamically and use that from then on *)
-          let new_dbconn_mutex = Mutex.create () in
-          Hashtbl.replace db_conn_locks db_conn new_dbconn_mutex ;
-          new_dbconn_mutex
+        match Hashtbl.find_opt db_conn_locks db_conn with
+        | Some x ->
+            x
+        | None ->
+            (* If we don't have a lock already for this connection then go make one dynamically and use that from then on *)
+            let new_dbconn_mutex = Mutex.create () in
+            Hashtbl.replace db_conn_locks db_conn new_dbconn_mutex ;
+            new_dbconn_mutex
     )
   in
   with_lock db_conn_m (fun () -> f ())

ocaml/database/stats.ml

@@ -77,10 +77,9 @@ let sample (name : string) (x : float) : unit =
   let x' = log x in
   with_lock timings_m (fun () ->
       let p =
-        if Hashtbl.mem timings name then
-          Hashtbl.find timings name
-        else
-          Normal_population.empty
+        Option.value
+          (Hashtbl.find_opt timings name)
+          ~default:Normal_population.empty
       in
       let p' = Normal_population.sample p x' in
       Hashtbl.replace timings name p'

ocaml/idl/dtd_backend.ml

@@ -110,14 +110,13 @@ let rec strings_of_dtd_element known_els = function
 
 let element known_els name children atts =
   let existing_children =
-    if Hashtbl.mem known_els name then
-      match Hashtbl.find known_els name with
-      | Element (_, c, att) ->
-          (c, att)
-      | _ ->
-          assert false
-    else
-      ([], [])
+    match Hashtbl.find_opt known_els name with
+    | Some (Element (_, c, att)) ->
+        (c, att)
+    | None ->
+        ([], [])
+    | _ ->
+        assert false
   in
   let open Xapi_stdext_std.Listext in
   let el =

ocaml/libs/http-lib/http_svr.ml

@@ -651,8 +651,11 @@ exception Socket_not_found
 (* Stop an HTTP server running on a socket *)
 let stop (socket, _name) =
   let server =
-    try Hashtbl.find socket_table socket
-    with Not_found -> raise Socket_not_found
+    match Hashtbl.find_opt socket_table socket with
+    | Some x ->
+        x
+    | None ->
+        raise Socket_not_found
   in
   Hashtbl.remove socket_table socket ;
   server.Server_io.shutdown ()

ocaml/libs/http-lib/mime.ml

@@ -42,7 +42,7 @@ let default_mime = "text/plain"
 
 (** Map a file extension to a MIME type *)
 let mime_of_ext mime ext =
-  try Hashtbl.find mime (lowercase ext) with Not_found -> default_mime
+  Option.value (Hashtbl.find_opt mime (lowercase ext)) ~default:default_mime
 
 (** Figure out a mime type from a full filename *)
 let mime_of_file_name mime fname =

ocaml/libs/stunnel/stunnel_cache.ml

@@ -187,12 +187,7 @@ let add (x : Stunnel.t) =
         ; verified= x.Stunnel.verified
         }
       in
-      let existing =
-        if Hashtbl.mem !index ep then
-          Hashtbl.find !index ep
-        else
-          []
-      in
+      let existing = Option.value (Hashtbl.find_opt !index ep) ~default:[] in
       Hashtbl.replace !index ep (idx :: existing) ;
       debug "Adding stunnel id %s (idle %.2f) to the cache" (id_of_stunnel x) 0. ;
       unlocked_gc ()

ocaml/libs/vhd/vhd_format_lwt_test/parse_test.ml

@@ -173,12 +173,13 @@ let initial = {to_close= []; to_unlink= []; child= None; contents= []}
 let sectors = Hashtbl.create 16
 
 let sector_lookup message =
-  if Hashtbl.mem sectors message then
-    Hashtbl.find sectors message
-  else
-    let data = fill_sector_with message in
-    Hashtbl.replace sectors message data ;
-    data
+  match Hashtbl.find_opt sectors message with
+  | Some x ->
+      x
+  | None ->
+      let data = fill_sector_with message in
+      Hashtbl.replace sectors message data ;
+      data
 
 let execute state = function
   | Create size ->

ocaml/libs/xapi-inventory/lib/inventory.ml

@@ -116,14 +116,16 @@ exception Missing_inventory_key of string
 let lookup ?default key =
   M.execute inventory_m (fun () ->
       if not !loaded_inventory then read_inventory_contents () ;
-      if Hashtbl.mem inventory key then
-        Hashtbl.find inventory key
-      else
+      match Hashtbl.find_opt inventory key with
+      | Some x ->
+          x
+      | None -> (
         match default with
         | None ->
             raise (Missing_inventory_key key)
         | Some v ->
             v
+      )
   )
 
 let flush_to_disk_locked () =

ocaml/message-switch/core/make.ml

@@ -189,14 +189,14 @@ functor
                     (fun (i, m) ->
                       M.Mutex.with_lock requests_m (fun () ->
                           match m.Message.kind with
-                          | Message.Response j ->
-                              if Hashtbl.mem wakener j then
+                          | Message.Response j -> (
+                            match Hashtbl.find_opt wakener j with
+                            | Some x ->
                                 let rec loop events_conn =
                                   Connection.rpc events_conn (In.Ack i)
                                   >>= function
                                   | Ok (_ : string) ->
-                                      M.Ivar.fill (Hashtbl.find wakener j) (Ok m) ;
-                                      return (Ok ())
+                                      M.Ivar.fill x (Ok m) ; return (Ok ())
                                   | Error _ ->
                                       reconnect ()
                                       >>|= fun (requests_conn, events_conn) ->
@@ -205,7 +205,7 @@ functor
                                       loop events_conn
                                 in
                                 loop events_conn
-                              else (
+                            | None ->
                                 Printf.printf "no wakener for id %s, %Ld\n%!"
                                   (fst i) (snd i) ;
                                 Hashtbl.iter
@@ -216,7 +216,7 @@ functor
                                   )
                                   wakener ;
                                 return (Ok ())
-                              )
+                          )
                           | Message.Request _ ->
                               return (Ok ())
                       )

ocaml/message-switch/switch/mswitch.ml

@@ -65,10 +65,7 @@ end
 let next_transfer_expected : (string, int64) Hashtbl.t = Hashtbl.create 128
 
 let get_next_transfer_expected name =
-  if Hashtbl.mem next_transfer_expected name then
-    Some (Hashtbl.find next_transfer_expected name)
-  else
-    None
+  Hashtbl.find_opt next_transfer_expected name
 
 let record_transfer time name = Hashtbl.replace next_transfer_expected name time
 

ocaml/message-switch/unix/protocol_unix.ml

@@ -294,17 +294,17 @@ module Client = struct
                       (* If the Ack doesn't belong to us then assume it's another thread *)
                       IO.Mutex.with_lock requests_m (fun () ->
                           match m.Message.kind with
-                          | Message.Response j ->
-                              if Hashtbl.mem wakener j then (
+                          | Message.Response j -> (
+                            match Hashtbl.find_opt wakener j with
+                            | Some x ->
                                 do_rpc t.events_conn (In.Ack i)
                                 >>|= fun (_ : string) ->
-                                IO.Ivar.fill (Hashtbl.find wakener j) (Ok m) ;
-                                Ok ()
-                              ) else (
+                                IO.Ivar.fill x (Ok m) ; Ok ()
+                            | None ->
                                 Printf.printf "no wakener for id %s,%Ld\n%!"
                                   (fst i) (snd i) ;
                                 Ok ()
-                              )
+                          )
                           | Message.Request _ ->
                               Ok ()
                       )

ocaml/networkd/bin/network_monitor_thread.ml

@@ -63,43 +63,41 @@ let send_bond_change_alert _dev interfaces message =
 let check_for_changes ~(dev : string) ~(stat : Network_monitor.iface_stats) =
   let open Network_monitor in
   match Astring.String.is_prefix ~affix:"vif" dev with
-  | true ->
-      ()
-  | false ->
-      if stat.nb_links > 1 then
-        if (* It is a bond. *)
-           Hashtbl.mem bonds_status dev then (
-          (* Seen before. *)
-          let nb_links_old, links_up_old = Hashtbl.find bonds_status dev in
-          if links_up_old <> stat.links_up then (
-            info "Bonds status changed: %s nb_links %d up %d up_old %d" dev
-              stat.nb_links stat.links_up links_up_old ;
-            Hashtbl.replace bonds_status dev (stat.nb_links, stat.links_up) ;
-            let msg =
-              Printf.sprintf "changed: %d/%d up (was %d/%d)" stat.links_up
-                stat.nb_links links_up_old nb_links_old
-            in
-            try send_bond_change_alert dev stat.interfaces msg
-            with e ->
-              debug "Error while sending alert BONDS_STATUS_CHANGED: %s\n%s"
-                (Printexc.to_string e)
-                (Printexc.get_backtrace ())
-          )
-        ) else (
-          (* Seen for the first time. *)
-          Hashtbl.add bonds_status dev (stat.nb_links, stat.links_up) ;
-          info "New bonds status: %s nb_links %d up %d" dev stat.nb_links
-            stat.links_up ;
-          if stat.links_up <> stat.nb_links then
-            let msg =
-              Printf.sprintf "is: %d/%d up" stat.links_up stat.nb_links
-            in
-            try send_bond_change_alert dev stat.interfaces msg
-            with e ->
-              debug "Error while sending alert BONDS_STATUS_CHANGED: %s\n%s"
-                (Printexc.to_string e)
-                (Printexc.get_backtrace ())
+  | false when stat.nb_links > 1 -> (
+    (* It is a bond. *)
+    match Hashtbl.find_opt bonds_status dev with
+    | Some (nb_links_old, links_up_old) ->
+        (* Seen before. *)
+        if links_up_old <> stat.links_up then (
+          info "Bonds status changed: %s nb_links %d up %d up_old %d" dev
+            stat.nb_links stat.links_up links_up_old ;
+          Hashtbl.replace bonds_status dev (stat.nb_links, stat.links_up) ;
+          let msg =
+            Printf.sprintf "changed: %d/%d up (was %d/%d)" stat.links_up
+              stat.nb_links links_up_old nb_links_old
+          in
+          try send_bond_change_alert dev stat.interfaces msg
+          with e ->
+            debug "Error while sending alert BONDS_STATUS_CHANGED: %s\n%s"
+              (Printexc.to_string e)
+              (Printexc.get_backtrace ())
         )
+    | None -> (
+        (* Seen for the first time. *)
+        Hashtbl.add bonds_status dev (stat.nb_links, stat.links_up) ;
+        info "New bonds status: %s nb_links %d up %d" dev stat.nb_links
+          stat.links_up ;
+        if stat.links_up <> stat.nb_links then
+          let msg = Printf.sprintf "is: %d/%d up" stat.links_up stat.nb_links in
+          try send_bond_change_alert dev stat.interfaces msg
+          with e ->
+            debug "Error while sending alert BONDS_STATUS_CHANGED: %s\n%s"
+              (Printexc.to_string e)
+              (Printexc.get_backtrace ())
+      )
+  )
+  | _ ->
+      ()
 
 let failed_again = ref false
 

ocaml/perftest/tests.ml

@@ -112,13 +112,13 @@ let parallel_with_vms async_op opname n vms rpc session_id test subtest_name =
           List.iter
             (fun task ->
               if List.mem task !active_tasks then (
-                ( if not (Hashtbl.mem tasks_to_vm task) then
+                ( match Hashtbl.find_opt tasks_to_vm task with
+                | None ->
                     debug ~out:stderr
                       "Ignoring completed task which doesn't correspond to a \
                        VM %s"
                       opname
-                  else
-                    let uuid = Hashtbl.find tasks_to_vm task in
+                | Some uuid ->
                     let started = Hashtbl.find vm_to_start_time uuid in
                     let time_taken = Unix.gettimeofday () -. started in
                     results := time_taken :: !results ;

ocaml/rrd2csv/src/rrd2csv.ml

@@ -110,30 +110,32 @@ let vm_uuid_to_name_label_map = Hashtbl.create 20
 let host_uuid_to_name_label_map = Hashtbl.create 10
 
 let get_vm_name_label vm_uuid =
-  if Hashtbl.mem vm_uuid_to_name_label_map vm_uuid then
-    Hashtbl.find vm_uuid_to_name_label_map vm_uuid
-  else
-    let name_label, _session_id =
-      XAPI.retry_with_session
-        (fun session_id () -> XAPI.get_vm_name_label ~session_id ~uuid:vm_uuid)
-        ()
-    in
-    Hashtbl.replace vm_uuid_to_name_label_map vm_uuid name_label ;
-    name_label
+  match Hashtbl.find_opt vm_uuid_to_name_label_map vm_uuid with
+  | Some x ->
+      x
+  | None ->
+      let name_label, _session_id =
+        XAPI.retry_with_session
+          (fun session_id () -> XAPI.get_vm_name_label ~session_id ~uuid:vm_uuid)
+          ()
+      in
+      Hashtbl.replace vm_uuid_to_name_label_map vm_uuid name_label ;
+      name_label
 
 let get_host_name_label host_uuid =
-  if Hashtbl.mem host_uuid_to_name_label_map host_uuid then
-    Hashtbl.find host_uuid_to_name_label_map host_uuid
-  else
-    let name_label, _session_id =
-      XAPI.retry_with_session
-        (fun session_id () ->
-          XAPI.get_host_name_label ~session_id ~uuid:host_uuid
-        )
-        ()
-    in
-    Hashtbl.replace host_uuid_to_name_label_map host_uuid name_label ;
-    name_label
+  match Hashtbl.find_opt host_uuid_to_name_label_map host_uuid with
+  | Some x ->
+      x
+  | None ->
+      let name_label, _session_id =
+        XAPI.retry_with_session
+          (fun session_id () ->
+            XAPI.get_host_name_label ~session_id ~uuid:host_uuid
+          )
+          ()
+      in
+      Hashtbl.replace host_uuid_to_name_label_map host_uuid name_label ;
+      name_label
 
 module Ds_selector = struct
   type t = {

ocaml/sdk-gen/csharp/gen_csharp_binding.ml

@@ -136,8 +136,8 @@ and gen_relations () =
 
 and process_relations ((oneClass, oneField), (manyClass, manyField)) =
   let value =
-    try (manyField, oneClass, oneField) :: Hashtbl.find relations manyClass
-    with Not_found -> [(manyField, oneClass, oneField)]
+    (manyField, oneClass, oneField)
+    :: Option.value (Hashtbl.find_opt relations manyClass) ~default:[]
   in
   Hashtbl.replace relations manyClass value