common/mlstdutils: Add ‘return’ statement for OCaml.

This adds a ‘return’ statement as found in other programming
languages.  You can use it like this:

  with_return (fun {return} ->
    some code ...
  )

where ‘some code’ may either return implicitly (as usual), or may call
‘return x’ to immediately return ‘x’.  All returned values must have
the same type.

The OCaml >= 4.04 implementation is by Petter A. Urkedal and octachron.
See this thread:
https://sympa.inria.fr/sympa/arc/caml-list/2017-11/msg00017.html

The version that works for any OCaml is by me.  (Note that my version
cannot be nested).

Author: rwmjones

common/mlstdutils/std_utils.ml

@@ -598,6 +598,22 @@ let protect ~f ~finally =
   finally ();
   match r with Either ret -> ret | Or exn -> raise exn
 
+type 'a return = { return: 'b. 'a -> 'b } (* OCaml >= 4.03: [@@unboxed] *)
+(* This requires features in OCaml >= 4.04:
+let with_return (type a) f =
+  let exception Return of a in
+  try f {return = fun ret -> raise (Return ret)} with Return ret -> ret
+*)
+
+(* This should work for any version of OCaml, but it doesn't work
+ * properly for nested with_return statements.  When we can assume
+ * OCaml >= 4.04 we should use the above definition instead.
+ *)
+let with_return f =
+  let ret = ref None in
+  try f {return = fun r -> ret := Some r; raise Exit}
+  with Exit -> match !ret with None -> assert false | Some r -> r
+
 let failwithf fs = ksprintf failwith fs
 
 exception Executable_not_found of string (* executable *)

common/mlstdutils/std_utils.mli

@@ -347,6 +347,20 @@ val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
     case, but requires a lot more work by the caller.  Perhaps we
     will change this in future.) *)
 
+type 'a return = { return: 'b. 'a -> 'b } (* OCaml >= 4.03: [@@unboxed] *)
+val with_return : ('a return -> 'a) -> 'a
+(** {v
+    with_return (fun {return} ->
+      some code ...
+    )
+    v}
+    emulates the [return] statement found in other programming
+    languages.
+
+    The ‘some code’ part may either return implicitly, or may call
+    [return x] to immediately return the value [x].  All returned
+    values must have the same type. *)
+
 val failwithf : ('a, unit, string, 'b) format4 -> 'a
 (** Like [failwith] but supports printf-like arguments. *)