[Libguestfs] [PATCH 9/9] ocaml: Use match + exception case in a few places.

Richard W.M. Jones rjones at redhat.com
Wed Oct 4 12:56:30 UTC 2017


In OCaml >= 4.02, match can catch exceptions.

Old code looks like:

  try
    match expr with
    | patt1 -> (* handle patt1 *)
    | patt2 -> ...
  with
    exn -> (* handle exception *)

New code looks like:

  match expr with
  | patt1 -> (* handle patt1 *)
  | patt2 -> ...
  | exception exn -> (* handle exception *)

*NB* These are not exactly equivalent, since in the old code an
exception thrown in the ‘(* handle patt1 *)’ code would be caught by
the exception handler, but this does NOT happen in the new code.
Therefore caution is advised when rewriting code.

See also:
https://blog.janestreet.com/pattern-matching-and-exception-handling-unite/
---
 builder/sources.ml              | 30 ++++++++++++------------------
 common/mlstdutils/std_utils.ml  |  8 +++-----
 daemon/inspect_fs_unix_fstab.ml | 10 ++++------
 daemon/inspect_utils.ml         | 18 ++++++------------
 v2v/parse_vmx.ml                | 10 ++++------
 5 files changed, 29 insertions(+), 47 deletions(-)

diff --git a/builder/sources.ml b/builder/sources.ml
index d6de15968..2710b5203 100644
--- a/builder/sources.ml
+++ b/builder/sources.ml
@@ -64,25 +64,19 @@ let parse_conf file =
                Utils.No_Key
             ) in
         let proxy =
-          try
-            (match (List.assoc ("proxy", None) fields) with
-            | "no" | "off" -> Curl.UnsetProxy
-            | "system" -> Curl.SystemProxy
-            | _ as proxy -> Curl.ForcedProxy proxy
-            )
-          with
-            Not_found -> Curl.SystemProxy in
+          match List.assoc ("proxy", None) fields with
+          | "no" | "off" -> Curl.UnsetProxy
+          | "system" -> Curl.SystemProxy
+          | _ as proxy -> Curl.ForcedProxy proxy
+          | exception Not_found -> Curl.SystemProxy in
         let format =
-          try
-            (match (List.assoc ("format", None) fields) with
-            | "native" | "" -> FormatNative
-            | "simplestreams" -> FormatSimpleStreams
-            | fmt ->
-               debug "unknown repository type '%s' in %s, skipping it" fmt file;
-               invalid_arg fmt
-            )
-          with
-            Not_found -> FormatNative in
+          match List.assoc ("format", None) fields with
+          | "native" | "" -> FormatNative
+          | "simplestreams" -> FormatSimpleStreams
+          | fmt ->
+             debug "unknown repository type '%s' in %s, skipping it" fmt file;
+             invalid_arg fmt
+          | exception Not_found -> FormatNative in
         {
           name = n; uri = uri; gpgkey = gpgkey; proxy = proxy;
           format = format;
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 37eef0348..0f691db0d 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -600,11 +600,9 @@ let may f = function
 type ('a, 'b) maybe = Either of 'a | Or of 'b
 
 let protect ~f ~finally =
-  let r =
-    try Either (f ())
-    with exn -> Or exn in
-  finally ();
-  match r with Either ret -> ret | Or exn -> raise exn
+  match f () with
+  | ret -> finally (); ret
+  | exception exn -> finally (); raise exn
 
 let failwithf fs = ksprintf failwith fs
 
diff --git a/daemon/inspect_fs_unix_fstab.ml b/daemon/inspect_fs_unix_fstab.ml
index e3c7fd1cd..16c5d5e7c 100644
--- a/daemon/inspect_fs_unix_fstab.ml
+++ b/daemon/inspect_fs_unix_fstab.ml
@@ -317,13 +317,11 @@ and resolve_fstab_device spec md_map os_type =
      * This makes it impossible to reverse those paths directly, so
      * we have implemented lvm_canonical_lv_name in the daemon.
      *)
-    try
-      match Lvm.lv_canonical spec with
-      | None -> Mountable.of_device spec
-      | Some device -> Mountable.of_device device
-    with
+    match Lvm.lv_canonical spec with
+    | None -> Mountable.of_device spec
+    | Some device -> Mountable.of_device device
     (* Ignore devices that don't exist. (RHBZ#811872) *)
-    | Unix.Unix_error (Unix.ENOENT, _, _) -> default
+    | exception Unix.Unix_error (Unix.ENOENT, _, _) -> default
   )
 
   else if PCRE.matches re_xdev spec then (
diff --git a/daemon/inspect_utils.ml b/daemon/inspect_utils.ml
index ef45ba9ee..94f728e3c 100644
--- a/daemon/inspect_utils.ml
+++ b/daemon/inspect_utils.ml
@@ -129,20 +129,14 @@ and aug_rm_noerrors aug path =
   with Augeas.Error _ -> 0
 
 let is_file_nocase path =
-  let path =
-    try Some (Realpath.case_sensitive_path path)
-    with _ -> None in
-  match path with
-  | None -> false
-  | Some path -> Is.is_file path
+  match Realpath.case_sensitive_path path with
+  | path -> Is.is_file path
+  | exception _ -> false
 
 and is_dir_nocase path =
-  let path =
-    try Some (Realpath.case_sensitive_path path)
-    with _ -> None in
-  match path with
-  | None -> false
-  | Some path -> Is.is_dir path
+  match Realpath.case_sensitive_path path with
+  | path -> Is.is_dir path
+  | exception _ -> false
 
 (* Rather hairy test for "is a partition", taken directly from
  * the old C inspection code.  XXX fix function and callers
diff --git a/v2v/parse_vmx.ml b/v2v/parse_vmx.ml
index 3c72527b9..2b8a86a14 100644
--- a/v2v/parse_vmx.ml
+++ b/v2v/parse_vmx.ml
@@ -338,12 +338,10 @@ and insert vmx value = function
        StringMap.add k (Key value) vmx
   | ns :: path ->
      let v =
-       try
-         (match StringMap.find ns vmx with
-          | Namespace vmx -> Some vmx
-          | Key _ -> None
-         )
-       with Not_found -> None in
+       match StringMap.find ns vmx with
+       | Namespace vmx -> Some vmx
+       | Key _ -> None
+       | exception Not_found -> None in
      let v =
        match v with
        | None ->
-- 
2.13.2




More information about the Libguestfs mailing list