Merge pull request #61 from mt-caret/uniform-and-float-arrays

Float and Uniform array support

.github/workflows/build.yml

@@ -46,7 +46,7 @@ jobs:
         uses: actions-rs/cargo@v1
         with:
           command: test
-      - run: opam install dune alcotest
+      - run: opam install dune alcotest base
       - name: Rust caller test
         run: cd testing/rust-caller; cargo test
       - name: Build OCaml caller

Cargo.toml

@@ -16,7 +16,7 @@ exclude = [
 features = [ "without-ocamlopt" ]
 
 [dependencies]
-ocaml-sys = "0.22"
+ocaml-sys = "0.23"
 ocaml-boxroot-sys = "0.2"
 static_assertions = "1.1.0"
 

src/conv/from_ocaml.rs

@@ -2,9 +2,13 @@
 // SPDX-License-Identifier: MIT
 
 use crate::{
-    mlvalues::{field_val, OCamlBytes, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList},
+    mlvalues::{
+        field_val, tag, OCamlBytes, OCamlFloat, OCamlFloatArray, OCamlInt, OCamlInt32, OCamlInt64,
+        OCamlList, OCamlUniformArray,
+    },
     value::OCaml,
 };
+use ocaml_sys::{caml_alloc, caml_sys_double_field};
 
 /// Implements conversion from OCaml values into Rust values.
 pub unsafe trait FromOCaml<T> {
@@ -137,6 +141,43 @@ where
     }
 }
 
+unsafe impl<A, OCamlA> FromOCaml<OCamlUniformArray<OCamlA>> for Vec<A>
+where
+    A: FromOCaml<OCamlA>,
+{
+    fn from_ocaml(v: OCaml<OCamlUniformArray<OCamlA>>) -> Self {
+        assert!(
+            v.tag_value() != tag::DOUBLE_ARRAY,
+            "unboxed float arrays are not supported"
+        );
+
+        let size = unsafe { v.size() };
+        let mut vec = Vec::with_capacity(size);
+        for i in 0..size {
+            vec.push(A::from_ocaml(unsafe { v.field(i) }));
+        }
+        vec
+    }
+}
+
+unsafe impl FromOCaml<OCamlFloatArray> for Vec<f64> {
+    fn from_ocaml(v: OCaml<OCamlFloatArray>) -> Self {
+        let size = unsafe { v.size() };
+
+        // an empty floatarray doesn't have the double array tag, but otherwise
+        // we always expect an unboxed float array.
+        if size > 0 {
+            assert_eq!(v.tag_value(), tag::DOUBLE_ARRAY)
+        };
+
+        let mut vec = Vec::with_capacity(size);
+        for i in 0..size {
+            vec.push(unsafe { caml_sys_double_field(v.raw(), i) });
+        }
+        vec
+    }
+}
+
 // Tuples
 
 macro_rules! tuple_from_ocaml {

src/conv/to_ocaml.rs

@@ -3,7 +3,10 @@
 
 use core::{borrow::Borrow, str};
 
+use ocaml_sys::{caml_alloc_float_array, caml_sys_store_double_field};
+
 use crate::{
+    internal::{caml_alloc, store_field},
     memory::{
         alloc_bigarray1, alloc_bytes, alloc_cons, alloc_double, alloc_error, alloc_int32,
         alloc_int64, alloc_ok, alloc_some, alloc_string, alloc_tuple, store_raw_field_at, OCamlRef,
@@ -15,7 +18,7 @@ use crate::{
     },
     runtime::OCamlRuntime,
     value::OCaml,
-    BoxRoot,
+    BoxRoot, OCamlFloatArray, OCamlUniformArray,
 };
 
 /// Implements conversion from Rust values into OCaml values.
@@ -208,6 +211,34 @@ where
     }
 }
 
+unsafe impl<A, OCamlA: 'static> ToOCaml<OCamlUniformArray<OCamlA>> for Vec<A>
+where
+    A: ToOCaml<OCamlA>,
+{
+    fn to_ocaml<'a>(&self, cr: &'a mut OCamlRuntime) -> OCaml<'a, OCamlUniformArray<OCamlA>> {
+        let result = BoxRoot::new(unsafe { OCaml::new(cr, caml_alloc(self.len(), 0)) });
+
+        for (i, elt) in self.iter().enumerate() {
+            let ov = elt.to_ocaml(cr);
+            unsafe { store_field(result.get_raw(), i, ov.raw()) };
+        }
+
+        result.get(cr)
+    }
+}
+
+unsafe impl ToOCaml<OCamlFloatArray> for Vec<f64> {
+    fn to_ocaml<'a>(&self, cr: &'a mut OCamlRuntime) -> OCaml<'a, OCamlFloatArray> {
+        let result = unsafe { OCaml::new(cr, caml_alloc_float_array(self.len())) };
+
+        for (i, elt) in self.iter().enumerate() {
+            unsafe { caml_sys_store_double_field(result.raw(), i, *elt) };
+        }
+
+        result
+    }
+}
+
 // Tuples
 
 macro_rules! tuple_to_ocaml {

src/lib.rs

@@ -300,7 +300,8 @@ pub use crate::error::OCamlException;
 pub use crate::memory::alloc_cons as cons;
 pub use crate::memory::OCamlRef;
 pub use crate::mlvalues::{
-    bigarray, DynBox, OCamlBytes, OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, RawOCaml,
+    bigarray, DynBox, OCamlBytes, OCamlFloat, OCamlFloatArray, OCamlInt, OCamlInt32, OCamlInt64,
+    OCamlList, OCamlUniformArray, RawOCaml,
 };
 pub use crate::runtime::OCamlRuntime;
 pub use crate::value::OCaml;

src/mlvalues.rs

@@ -20,6 +20,20 @@ pub struct OCamlList<A> {
     _marker: PhantomData<A>,
 }
 
+/// [`OCaml`]`<OCamlUniformArray<T>>` is a reference to an OCaml array which is
+/// guaranteed to not contain unboxed floats. If OCaml was configured with
+/// `--disable-flat-float-array` this corresponds to regular `array`s, but if
+/// not, `Uniform_array.t` in the `base` library can be used instead.
+/// See [Lexifi's blog post on the topic](https://www.lexifi.com/blog/ocaml/about-unboxed-float-arrays/)
+/// for more details.
+pub struct OCamlUniformArray<A> {
+    _marker: PhantomData<A>,
+}
+
+/// [`OCaml`]`<OCamlFloatArray<T>>` is a reference to an OCaml `floatarray`
+/// which is an array containing `float`s in an unboxed form.
+pub struct OCamlFloatArray {}
+
 /// `OCaml<DynBox<T>>` is for passing a value of type `T` to OCaml
 ///
 /// To box a Rust value, use [`OCaml::box_value`][crate::OCaml::box_value].

src/mlvalues/tag.rs

@@ -1,7 +1,9 @@
 // Copyright (c) Viable Systems and TezEdge Contributors
 // SPDX-License-Identifier: MIT
 
-pub use ocaml_sys::{Tag, CLOSURE, NO_SCAN, STRING, TAG_CONS as CONS, TAG_SOME as SOME};
+pub use ocaml_sys::{
+    Tag, CLOSURE, DOUBLE_ARRAY, NO_SCAN, STRING, TAG_CONS as CONS, TAG_SOME as SOME,
+};
 
 pub const TAG_POLYMORPHIC_VARIANT: Tag = 0;
 pub const TAG_OK: Tag = 0;

src/value.rs

@@ -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)]

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

@@ -21,45 +21,47 @@ type movement_polymorphic =
 
 module Rust = struct
   external tests_teardown : unit -> unit = "ocaml_interop_teardown"
-
   external twice : int -> int = "rust_twice"
-
   external twice_boxed_i64 : int64 -> int64 = "rust_twice_boxed_i64"
-
   external twice_boxed_i32 : int32 -> int32 = "rust_twice_boxed_i32"
-
   external twice_boxed_float : float -> float = "rust_twice_boxed_float"
 
   external twice_unboxed_float : (float[@unboxed]) -> (float[@unboxed])
     = "" "rust_twice_unboxed_float"
 
   external add_unboxed_floats_noalloc : float -> float -> float
     = "" "rust_add_unboxed_floats_noalloc"
-    [@@unboxed] [@@noalloc]
+  [@@unboxed] [@@noalloc]
 
   external increment_bytes : bytes -> int -> bytes = "rust_increment_bytes"
 
   external increment_ints_list : int list -> int list
     = "rust_increment_ints_list"
 
-  external make_tuple : string -> int -> string * int = "rust_make_tuple"
+  external increment_ints_uniform_array :
+    int Base.Uniform_array.t -> int Base.Uniform_array.t
+    = "rust_increment_ints_uniform_array"
 
-  external make_some : string -> string option = "rust_make_some"
+  external increment_floats_uniform_array :
+    float Base.Uniform_array.t -> float Base.Uniform_array.t
+    = "rust_increment_floats_uniform_array"
 
-  external make_ok : int -> (int, string) result = "rust_make_ok"
+  external increment_floats_float_array : floatarray -> floatarray
+    = "rust_increment_floats_float_array"
 
+  external make_tuple : string -> int -> string * int = "rust_make_tuple"
+  external make_some : string -> string option = "rust_make_some"
+  external make_ok : int -> (int, string) result = "rust_make_ok"
   external make_error : string -> (int, string) result = "rust_make_error"
-
   external sleep_releasing : int -> unit = "rust_sleep_releasing"
-
   external sleep : int -> unit = "rust_sleep"
-
   external string_of_movement : movement -> string = "rust_string_of_movement"
 
   external string_of_polymorphic_movement : movement_polymorphic -> string
     = "rust_string_of_polymorphic_movement"
 
-  external rust_rust_add_7ints : int -> int -> int -> int -> int -> int -> int -> int
+  external rust_rust_add_7ints :
+    int -> int -> int -> int -> int -> int -> int -> int
     = "rust_rust_add_7ints_byte" "rust_rust_add_7ints"
 end
 
@@ -98,6 +100,35 @@ let test_increment_ints_list () =
   let result = Rust.increment_ints_list [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 ] in
   Alcotest.(check (list int)) "Increment ints in list" expected result
 
+let test_increment_ints_uniform_array () =
+  let expected = [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ] in
+  let result =
+    Base.Uniform_array.to_list
+      (Rust.increment_ints_uniform_array
+         (Base.Uniform_array.of_list [ 0; 1; 2; 3; 4; 5; 6; 7; 8; 9 ]))
+  in
+  Alcotest.(check (list int)) "Increment ints in uniform array" expected result
+
+let test_increment_floats_uniform_array () =
+  let expected = [ 1.; 2.; 3.; 4.; 5.; 6.; 7.; 8.; 9.; 10. ] in
+  let result =
+    Base.Uniform_array.to_list
+      (Rust.increment_floats_uniform_array
+         (Base.Uniform_array.of_list [ 0.; 1.; 2.; 3.; 4.; 5.; 6.; 7.; 8.; 9. ]))
+  in
+  Alcotest.(check (list (float 0.)))
+    "Increment ints in uniform array" expected result
+
+let test_increment_floats_float_array () =
+  let expected = [ 1.; 2.; 3.; 4.; 5.; 6.; 7.; 8.; 9.; 10. ] in
+  let result =
+    Float.Array.to_list
+      (Rust.increment_floats_float_array
+         (Float.Array.of_list [ 0.; 1.; 2.; 3.; 4.; 5.; 6.; 7.; 8.; 9. ]))
+  in
+  Alcotest.(check (list (float 0.)))
+    "Increment ints in uniform array" expected result
+
 let test_make_tuple () =
   let expected = ("fst", 9) in
   let result = Rust.make_tuple "fst" 9 in
@@ -192,6 +223,12 @@ let () =
           test_case "Rust.twice_unboxed_float" `Quick test_twice_unboxed_float;
           test_case "Rust.increment_bytes" `Quick test_increment_bytes;
           test_case "Rust.increment_ints_list" `Quick test_increment_ints_list;
+          test_case "Rust.increment_ints_uniform_array" `Quick
+            test_increment_ints_uniform_array;
+          test_case "Rust.increment_floats_uniform_array" `Quick
+            test_increment_floats_uniform_array;
+          test_case "Rust.increment_floats_float_array" `Quick
+            test_increment_floats_float_array;
           test_case "Rust.make_tuple" `Quick test_make_tuple;
           test_case "Rust.make_some" `Quick test_make_some;
           test_case "Rust.make_ok" `Quick test_make_ok;
@@ -201,7 +238,7 @@ let () =
           test_case "Rust.string_of_movement" `Quick test_interpret_movement;
           test_case "Rust.string_of_polymorphic_movement" `Quick
             test_interpret_polymorphic_movement;
-          test_case "Rust.rust_rust_add_7ints" `Quick test_byte_function
+          test_case "Rust.rust_rust_add_7ints" `Quick test_byte_function;
         ] );
     ];
   Rust.tests_teardown ()

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

@@ -3,7 +3,8 @@
 
 use ocaml_interop::{
     ocaml_export, ocaml_unpack_polymorphic_variant, ocaml_unpack_variant, OCaml, OCamlBytes,
-    OCamlFloat, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, OCamlRef, ToOCaml,
+    OCamlFloat, OCamlFloatArray, OCamlInt, OCamlInt32, OCamlInt64, OCamlList, OCamlRef,
+    OCamlUniformArray, ToOCaml,
 };
 use std::{thread, time};
 
@@ -73,6 +74,36 @@ ocaml_export! {
         vec.to_ocaml(cr)
     }
 
+    fn rust_increment_ints_uniform_array(cr, ints: OCamlRef<OCamlUniformArray<OCamlInt>>) -> OCaml<OCamlUniformArray<OCamlInt>> {
+        let mut vec: Vec<i64> = ints.to_rust(cr);
+
+        for i in 0..vec.len() {
+            vec[i] += 1;
+        }
+
+        vec.to_ocaml(cr)
+    }
+
+    fn rust_increment_floats_uniform_array(cr, ints: OCamlRef<OCamlUniformArray<OCamlFloat>>) -> OCaml<OCamlUniformArray<OCamlFloat>> {
+        let mut vec: Vec<f64> = ints.to_rust(cr);
+
+        for i in 0..vec.len() {
+            vec[i] += 1.;
+        }
+
+        vec.to_ocaml(cr)
+    }
+
+    fn rust_increment_floats_float_array(cr, ints: OCamlRef<OCamlFloatArray>) -> OCaml<OCamlFloatArray> {
+        let mut vec: Vec<f64> = ints.to_rust(cr);
+
+        for i in 0..vec.len() {
+            vec[i] += 1.;
+        }
+
+        vec.to_ocaml(cr)
+    }
+
     fn rust_make_tuple(cr, fst: OCamlRef<String>, snd: OCamlRef<OCamlInt>) -> OCaml<(String, OCamlInt)> {
         let fst: String = fst.to_rust(cr);
         let snd: i64 = snd.to_rust(cr);