track exceptions with the borrow checker properly

src/closure.rs

@@ -1,9 +1,8 @@
 // Copyright (c) Viable Systems and TezEdge Contributors
 // SPDX-License-Identifier: MIT
 
-use crate::error::OCamlException;
 use crate::mlvalues::tag;
-use crate::mlvalues::{extract_exception, is_exception_result, tag_val, RawOCaml};
+use crate::mlvalues::{tag_val, RawOCaml};
 use crate::value::OCaml;
 use crate::{OCamlRef, OCamlRuntime};
 use ocaml_sys::{
@@ -70,11 +69,9 @@ impl OCamlClosure {
         cr: &'a mut OCamlRuntime,
         result: RawOCaml,
     ) -> OCaml<'a, R> {
-        if is_exception_result(result) {
-            let ex = unsafe { OCamlException::of(extract_exception(result)) };
-            panic!("OCaml exception, message: {:?}", ex.message())
-        } else {
-            unsafe { OCaml::new(cr, result) }
+        match unsafe { OCaml::of_exception_result(cr, result) } {
+            Some(ex) => panic!("OCaml exception, message: {:?}", ex.message()),
+            None => unsafe { OCaml::new(cr, result) },
         }
     }
 }

src/error.rs

@@ -1,16 +1,8 @@
 // Copyright (c) Viable Systems and TezEdge Contributors
 // SPDX-License-Identifier: MIT
 
-use crate::mlvalues::{is_block, string_val, tag_val, RawOCaml};
-use crate::mlvalues::{tag, MAX_FIXNUM, MIN_FIXNUM};
-use core::{fmt, slice};
-use ocaml_sys::caml_string_length;
-
-/// An OCaml exception value.
-#[derive(Debug)]
-pub struct OCamlException {
-    raw: RawOCaml,
-}
+use crate::mlvalues::{MAX_FIXNUM, MIN_FIXNUM};
+use core::fmt;
 
 #[derive(Debug)]
 pub enum OCamlFixnumConversionError {
@@ -34,30 +26,3 @@ impl fmt::Display for OCamlFixnumConversionError {
         }
     }
 }
-
-impl OCamlException {
-    #[doc(hidden)]
-    pub unsafe fn of(raw: RawOCaml) -> Self {
-        OCamlException { raw }
-    }
-
-    pub fn message(&self) -> Option<String> {
-        if is_block(self.raw) {
-            unsafe {
-                let message = *(self.raw as *const RawOCaml).add(1);
-
-                if is_block(message) && tag_val(message) == tag::STRING {
-                    let error_message =
-                        slice::from_raw_parts(string_val(message), caml_string_length(message))
-                            .to_owned();
-                    let error_message = String::from_utf8_unchecked(error_message);
-                    Some(error_message)
-                } else {
-                    None
-                }
-            }
-        } else {
-            None
-        }
-    }
-}

src/lib.rs

@@ -296,11 +296,12 @@ pub use crate::boxroot::BoxRoot;
 
 pub use crate::closure::{OCamlFn1, OCamlFn2, OCamlFn3, OCamlFn4, OCamlFn5};
 pub use crate::conv::{FromOCaml, ToOCaml};
-pub use crate::error::OCamlException;
 pub use crate::memory::alloc_cons as cons;
 pub use crate::memory::OCamlRef;
+pub use crate::memory::{alloc_error, alloc_ok};
 pub use crate::mlvalues::{
-    bigarray, DynBox, OCamlBytes, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, RawOCaml,
+    bigarray, DynBox, OCamlBytes, OCamlException, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64,
+    OCamlList, RawOCaml,
 };
 pub use crate::runtime::OCamlRuntime;
 pub use crate::value::OCaml;

src/mlvalues.rs

@@ -49,5 +49,5 @@ pub struct OCamlInt64 {}
 /// [`OCaml`]`<OCamlFloat>` is a reference to an OCaml `float` (boxed `float`) value.
 pub struct OCamlFloat {}
 
-/// [`OCaml`]`<OCamlException2>` is a reference to an OCaml `exn` value.
-pub struct OCamlException2 {}
+/// [`OCaml`]`<OCamlException>` is a reference to an OCaml `exn` value.
+pub struct OCamlException {}

src/mlvalues/bigarray.rs

@@ -5,7 +5,7 @@ use core::marker::PhantomData;
 /// # Safety
 ///
 /// This is unsafe to implement, because it allows casts
-/// to the implementing type (through OCaml<Array1<T>>::as_slice()).
+/// to the implementing type (through `OCaml<Array1<T>>::as_slice()`).
 ///
 /// To make this safe, the type implementing this trait must be
 /// safe to transmute from OCaml data with the relevant KIND.

src/mlvalues/tag.rs

@@ -4,5 +4,10 @@
 pub use ocaml_sys::{Tag, CLOSURE, NO_SCAN, STRING, TAG_CONS as CONS, TAG_SOME as SOME};
 
 pub const TAG_POLYMORPHIC_VARIANT: Tag = 0;
+
+/// Note that `TAG_EXCEPTION`` is equivalent to `TAG_POLYMORPHIC_VARIANT`, and also
+/// corresponds to the tag associated with records and tuples.
+pub const TAG_EXCEPTION: Tag = 0;
+
 pub const TAG_OK: Tag = 0;
 pub const TAG_ERROR: Tag = 1;

src/value.rs

@@ -6,7 +6,7 @@ use crate::{
     error::OCamlFixnumConversionError,
     memory::{alloc_box, OCamlCell},
     mlvalues::*,
-    FromOCaml, OCamlException, OCamlRef, OCamlRuntime,
+    FromOCaml, OCamlRef, OCamlRuntime,
 };
 use core::any::Any;
 use core::borrow::Borrow;
@@ -48,14 +48,19 @@ impl<'a, T> OCaml<'a, T> {
         }
     }
 
+    #[doc(hidden)]
+    pub unsafe fn size(&self) -> UIntnat {
+        wosize_val(self.raw)
+    }
+
     #[doc(hidden)]
     pub unsafe fn field<F>(&self, i: UIntnat) -> OCaml<'a, F> {
         assert!(
             tag_val(self.raw) < tag::NO_SCAN,
             "unexpected OCaml value tag >= NO_SCAN"
         );
         assert!(
-            i < wosize_val(self.raw),
+            i < self.size(),
             "trying to access a field bigger than the OCaml block value"
         );
         OCaml {
@@ -71,7 +76,7 @@ impl<'a, T> OCaml<'a, T> {
 
     #[doc(hidden)]
     pub fn is_block_sized(&self, size: usize) -> bool {
-        self.is_block() && unsafe { wosize_val(self.raw) == size }
+        self.is_block() && unsafe { self.size() == size }
     }
 
     #[doc(hidden)]
@@ -502,6 +507,37 @@ impl<'a, A: bigarray::BigarrayElt> OCaml<'a, bigarray::Array1<A>> {
     }
 }
 
+impl<'a> OCaml<'a, OCamlException> {
+    #[doc(hidden)]
+    pub unsafe fn of_exception_result(
+        cr: &'a OCamlRuntime,
+        exception_result: RawOCaml,
+    ) -> Option<OCaml<'a, OCamlException>> {
+        if is_exception_result(exception_result) {
+            Some(OCaml::new(cr, extract_exception(exception_result)))
+        } else {
+            None
+        }
+    }
+
+    /// If the exception has a single argument of type string, extracts and
+    /// returns it. Examples of such exceptions are `Failure of string`
+    /// (raised via the `failwith` OCaml function, or the
+    /// `caml_raise_with_string` C function) or `Invalid_argument of string`.
+    pub fn message(&self) -> Option<String> {
+        if self.is_block_sized(2) && self.tag_value() == tag::TAG_EXCEPTION {
+            let exn_argument: OCaml<String> = unsafe { self.field(1) };
+            if exn_argument.is_block() && exn_argument.tag_value() == tag::STRING {
+                Some(exn_argument.to_rust())
+            } else {
+                None
+            }
+        } else {
+            None
+        }
+    }
+}
+
 // Functions
 
 pub enum RefOrRooted<'a, 'b, T: 'static> {
@@ -552,18 +588,16 @@ macro_rules! try_call_impl {
                     &self,
                     cr: &'c mut OCamlRuntime,
                     $($argname: $argname),+
-                ) -> Result<OCaml<'c, RetT>, OCamlException>
+                ) -> Result<OCaml<'c, RetT>, OCaml<'c, OCamlException>>
                 where
                     $($argname: OCamlParam<'a, 'b, $rt, $ot>),+
                 {
                     $(let $argname = $argname.to_rooted(cr);)*
 
                     let result = unsafe { $method(self.get_raw(), $($argname.get_raw()),+) };
-                    if is_exception_result(result) {
-                        let ex = unsafe { OCamlException::of(extract_exception(result)) };
-                        Err(ex)
-                    } else {
-                        Ok(unsafe { OCaml::new(cr, result) })
+                    match unsafe { OCaml::of_exception_result(cr, result) } {
+                        Some(ex) => Err(ex),
+                        None => Ok(unsafe { OCaml::new(cr, result) })
                     }
                 }
             }
@@ -577,7 +611,7 @@ macro_rules! try_call_impl {
                     &self,
                     cr: &'c mut OCamlRuntime,
                     $($argname2: $argname2),*
-                ) -> Result<OCaml<'c, RetT>, OCamlException>
+                ) -> Result<OCaml<'c, RetT>, OCaml<'c, OCamlException>>
                 where
                     $($argname2: OCamlParam<'a, 'b, $rt2, $ot2>),*
                 {
@@ -588,11 +622,9 @@ macro_rules! try_call_impl {
                     };
 
                     let result = unsafe { caml_callbackN_exn(self.get_raw(), args.len(), args.as_mut_ptr()) };
-                    if is_exception_result(result) {
-                        let ex = unsafe { OCamlException::of(extract_exception(result)) };
-                        Err(ex)
-                    } else {
-                        Ok(unsafe { OCaml::new(cr, result) })
+                    match unsafe { OCaml::of_exception_result(cr, result) } {
+                        Some(ex) => Err(ex),
+                        None => Ok(unsafe { OCaml::new(cr, result) })
                     }
                 }
             }

testing/ocaml-caller/dune

@@ -1,7 +1,8 @@
 (executables
  (names ocaml_rust_caller)
- (libraries alcotest callable_rust threads.posix))
+ (libraries alcotest base callable_rust threads.posix))
 
 (rule
- (alias  runtest)
- (action (run ./ocaml_rust_caller.exe)))
+ (alias runtest)
+ (action
+  (run ./ocaml_rust_caller.exe)))

testing/ocaml-caller/ocaml_rust_caller.ml

@@ -52,6 +52,9 @@ module Rust = struct
   external call_ocaml_closure : (int -> int) -> (int, string) result
     = "rust_call_ocaml_closure"
 
+  external call_ocaml_closure_and_return_exn : (int -> int) -> (int, exn) result
+    = "rust_call_ocaml_closure_and_return_exn"
+
   external rust_rust_add_7ints :
     int -> int -> int -> int -> int -> int -> int -> int
     = "rust_rust_add_7ints_byte" "rust_rust_add_7ints"
@@ -152,6 +155,22 @@ let test_call_ocaml_closure () =
   in
   Alcotest.(check (list (result int string))) "Call a closure" expected result
 
+let test_call_ocaml_closure_and_return_exn () =
+  let expected =
+    [ Ok 1; Error (Failure "some error message"); Error Not_found ]
+  in
+  let result =
+    [
+      Rust.call_ocaml_closure_and_return_exn (fun x -> x + 1);
+      Rust.call_ocaml_closure_and_return_exn (fun _ ->
+          failwith "some error message");
+      Rust.call_ocaml_closure_and_return_exn (fun _ -> raise Not_found);
+    ]
+  in
+  let exn = Alcotest.of_pp Base.Exn.pp in
+  Alcotest.(check (list (result int exn)))
+    "Call a closure and return exn" expected result
+
 let test_byte_function () =
   let expected = 1 + 2 + 3 + 4 + 5 + 6 + 7 in
   let result = Rust.rust_rust_add_7ints 1 2 3 4 5 6 7 in
@@ -207,6 +226,8 @@ let () =
           test_case "Rust.string_of_polymorphic_movement" `Quick
             test_interpret_polymorphic_movement;
           test_case "Rust.call_ocaml_closure" `Quick test_call_ocaml_closure;
+          test_case "Rust.call_ocaml_closure_and_return_exn" `Quick
+            test_call_ocaml_closure_and_return_exn;
           test_case "Rust.rust_rust_add_7ints" `Quick test_byte_function;
         ] );
     ];

testing/ocaml-caller/rust/src/lib.rs

@@ -2,8 +2,9 @@
 // SPDX-License-Identifier: MIT
 
 use ocaml_interop::{
-    ocaml_export, ocaml_unpack_polymorphic_variant, ocaml_unpack_variant, OCaml, OCamlBytes,
-    OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, OCamlRef, ToOCaml,
+    alloc_error, alloc_ok, ocaml_export, ocaml_unpack_polymorphic_variant, ocaml_unpack_variant,
+    OCaml, OCamlBytes, OCamlException, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList,
+    OCamlRef, ToOCaml,
 };
 use std::{thread, time};
 
@@ -157,6 +158,25 @@ ocaml_export! {
         call_result.to_ocaml(cr)
     }
 
+    fn rust_call_ocaml_closure_and_return_exn(cr, ocaml_function: OCamlRef<fn(OCamlInt) -> OCamlInt>) -> OCaml<Result<OCamlInt, OCamlException>> {
+        let ocaml_function = ocaml_function.to_boxroot(cr);
+
+        let call_result: Result<OCaml<OCamlInt>, OCaml<OCamlException>> =
+            ocaml_function
+            .try_call(cr, &0i64);
+
+        match call_result {
+            Ok(value) => {
+                let ocaml_value = value.root();
+                alloc_ok(cr, &ocaml_value)
+            },
+            Err(error) => {
+                let ocaml_error = error.root();
+                alloc_error(cr, &ocaml_error)
+            }
+        }
+    }
+
     fn rust_rust_add_7ints|rust_rust_add_7ints_byte(
         cr,
         int1: OCamlRef<OCamlInt>,