From 276cb684ac30e1ab4cb253f299994261e52b6353 Mon Sep 17 00:00:00 2001 From: mtakeda Date: Sat, 27 Jan 2024 09:00:57 +0000 Subject: [PATCH 1/2] Float and Uniform array support --- Cargo.toml | 2 +- src/conv/from_ocaml.rs | 43 +++++++++++++++- src/conv/to_ocaml.rs | 33 +++++++++++- src/lib.rs | 3 +- src/mlvalues.rs | 14 +++++ src/mlvalues/tag.rs | 4 +- src/value.rs | 9 +++- testing/ocaml-caller/dune | 7 +-- testing/ocaml-caller/ocaml_rust_caller.ml | 63 ++++++++++++++++++----- testing/ocaml-caller/rust/src/lib.rs | 33 +++++++++++- 10 files changed, 187 insertions(+), 24 deletions(-) diff --git a/Cargo.toml b/Cargo.toml index 159a231..2aa2606 100644 --- a/Cargo.toml +++ b/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" diff --git a/src/conv/from_ocaml.rs b/src/conv/from_ocaml.rs index eceadff..e92e8dc 100644 --- a/src/conv/from_ocaml.rs +++ b/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 { @@ -137,6 +141,43 @@ where } } +unsafe impl FromOCaml> for Vec +where + A: FromOCaml, +{ + fn from_ocaml(v: OCaml>) -> 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 for Vec { + fn from_ocaml(v: OCaml) -> 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 { diff --git a/src/conv/to_ocaml.rs b/src/conv/to_ocaml.rs index 4dd5ef2..df23f97 100644 --- a/src/conv/to_ocaml.rs +++ b/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 ToOCaml> for Vec +where + A: ToOCaml, +{ + fn to_ocaml<'a>(&self, cr: &'a mut OCamlRuntime) -> OCaml<'a, OCamlUniformArray> { + 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 for Vec { + 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 { diff --git a/src/lib.rs b/src/lib.rs index 998a051..de6da19 100644 --- a/src/lib.rs +++ b/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; diff --git a/src/mlvalues.rs b/src/mlvalues.rs index 1a0cefc..160000e 100644 --- a/src/mlvalues.rs +++ b/src/mlvalues.rs @@ -20,6 +20,20 @@ pub struct OCamlList { _marker: PhantomData, } +/// [`OCaml`]`>` 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 { + _marker: PhantomData, +} + +/// [`OCaml`]`>` is a reference to an OCaml `floatarray` +/// which is an array containing `float`s in an unboxed form. +pub struct OCamlFloatArray {} + /// `OCaml>` is for passing a value of type `T` to OCaml /// /// To box a Rust value, use [`OCaml::box_value`][crate::OCaml::box_value]. diff --git a/src/mlvalues/tag.rs b/src/mlvalues/tag.rs index 4eaeb94..c27db15 100644 --- a/src/mlvalues/tag.rs +++ b/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; diff --git a/src/value.rs b/src/value.rs index 3507ec2..24ba605 100644 --- a/src/value.rs +++ b/src/value.rs @@ -48,6 +48,11 @@ impl<'a, T> OCaml<'a, T> { } } + #[doc(hidden)] + pub unsafe fn size(&self) -> UIntnat { + wosize_val(self.raw) + } + #[doc(hidden)] pub unsafe fn field(&self, i: UIntnat) -> OCaml<'a, F> { assert!( @@ -55,7 +60,7 @@ impl<'a, T> OCaml<'a, T> { "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)] diff --git a/testing/ocaml-caller/dune b/testing/ocaml-caller/dune index e564763..04d0e36 100644 --- a/testing/ocaml-caller/dune +++ b/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))) \ No newline at end of file + (alias runtest) + (action + (run ./ocaml_rust_caller.exe))) diff --git a/testing/ocaml-caller/ocaml_rust_caller.ml b/testing/ocaml-caller/ocaml_rust_caller.ml index 23f83c2..15a4ee2 100644 --- a/testing/ocaml-caller/ocaml_rust_caller.ml +++ b/testing/ocaml-caller/ocaml_rust_caller.ml @@ -21,13 +21,9 @@ 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]) @@ -35,31 +31,37 @@ module Rust = struct 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 () diff --git a/testing/ocaml-caller/rust/src/lib.rs b/testing/ocaml-caller/rust/src/lib.rs index 3b5e309..94dddde 100644 --- a/testing/ocaml-caller/rust/src/lib.rs +++ b/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>) -> OCaml> { + let mut vec: Vec = 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>) -> OCaml> { + let mut vec: Vec = 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) -> OCaml { + let mut vec: Vec = ints.to_rust(cr); + + for i in 0..vec.len() { + vec[i] += 1.; + } + + vec.to_ocaml(cr) + } + fn rust_make_tuple(cr, fst: OCamlRef, snd: OCamlRef) -> OCaml<(String, OCamlInt)> { let fst: String = fst.to_rust(cr); let snd: i64 = snd.to_rust(cr); From a1195e50c0e03cc6a20f134d68bc700ad6beef9d Mon Sep 17 00:00:00 2001 From: mtakeda Date: Sun, 28 Jan 2024 07:09:34 +0000 Subject: [PATCH 2/2] Install base library in github build workflow --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index b554fe7..3d9068e 100644 --- a/.github/workflows/build.yml +++ b/.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