use crate::error::{CamlError, Error};
use crate::tag::Tag;
use crate::{interop::BoxRoot, root::Root, sys, util, OCaml, OCamlRef, Runtime};
pub type Size = sys::Size;
#[derive(Debug, Clone, PartialEq, PartialOrd)]
pub struct Value(pub Root);
#[derive(Debug, Clone, Copy, PartialEq, PartialOrd)]
#[repr(transparent)]
pub struct Raw(pub sys::Value);
impl AsRef<sys::Value> for Raw {
fn as_ref(&self) -> &sys::Value {
&self.0
}
}
impl From<sys::Value> for Raw {
fn from(x: sys::Value) -> Raw {
Raw(x)
}
}
impl From<Raw> for sys::Value {
fn from(x: Raw) -> sys::Value {
x.0
}
}
pub unsafe trait IntoValue {
fn into_value(self, rt: &Runtime) -> Value;
}
pub unsafe trait FromValue<'a> {
fn from_value(v: Value) -> Self;
}
unsafe impl IntoValue for Value {
fn into_value(self, _rt: &Runtime) -> Value {
self
}
}
unsafe impl<'a> FromValue<'a> for Value {
#[allow(clippy::wrong_self_convention)]
fn from_value(v: Value) -> Value {
v
}
}
unsafe impl IntoValue for Raw {
fn into_value(self, _rt: &Runtime) -> Value {
unsafe { Value::new(self.0) }
}
}
unsafe impl<'a> FromValue<'a> for Raw {
#[inline]
fn from_value(v: Value) -> Raw {
v.raw()
}
}
unsafe impl<'a, T> IntoValue for OCaml<'a, T> {
fn into_value(self, _rt: &Runtime) -> Value {
unsafe { Value::new(self.raw()) }
}
}
unsafe impl<'a, T> IntoValue for OCamlRef<'a, T> {
fn into_value(self, _rt: &Runtime) -> Value {
unsafe { Value::new(self.get_raw()) }
}
}
unsafe impl<T> IntoValue for BoxRoot<T> {
fn into_value(self, _rt: &Runtime) -> Value {
unsafe { Value::new(self.get_raw()) }
}
}
unsafe impl<'a, T> FromValue<'a> for BoxRoot<T> {
fn from_value(v: Value) -> BoxRoot<T> {
let ocaml: OCaml<'a, T> = FromValue::from_value(v);
ocaml.root()
}
}
unsafe impl<'a, T> FromValue<'a> for OCaml<'a, T> {
fn from_value<'b>(v: Value) -> OCaml<'a, T> {
let rt = unsafe { Runtime::recover_handle() };
unsafe { OCaml::new(rt, v.raw().into()) }
}
}
unsafe impl<T> crate::interop::ToOCaml<T> for Value {
fn to_ocaml<'a>(&self, gc: &'a mut Runtime) -> OCaml<'a, T> {
unsafe { OCaml::new(gc, self.raw().into()) }
}
}
unsafe impl<'a, T> crate::interop::FromOCaml<T> for Value {
fn from_ocaml(v: OCaml<T>) -> Value {
unsafe { Value::new(v.raw()) }
}
}
impl Value {
pub fn raw(&self) -> Raw {
unsafe { Raw(self.0.get()) }
}
pub unsafe fn named(name: &str) -> Option<Value> {
let s = match util::CString::new(name) {
Ok(s) => s,
Err(_) => return None,
};
let named = sys::caml_named_value(s.as_ptr());
if named.is_null() {
return None;
}
Some(Value::new(*named))
}
pub unsafe fn alloc(n: usize, tag: Tag) -> Value {
Value::new(sys::caml_alloc(n, tag.into()))
}
pub unsafe fn alloc_tuple(n: usize) -> Value {
Value::new(sys::caml_alloc_tuple(n))
}
pub unsafe fn alloc_small(n: usize, tag: Tag) -> Value {
Value::new(sys::caml_alloc_small(n, tag.into()))
}
pub unsafe fn alloc_final<T>(
finalizer: unsafe extern "C" fn(Raw),
cfg: Option<(usize, usize)>,
) -> Value {
let (used, max) = cfg.unwrap_or((0, 1));
Value::new(sys::caml_alloc_final(
core::mem::size_of::<T>(),
core::mem::transmute(finalizer),
used,
max,
))
}
pub unsafe fn alloc_custom<T: crate::Custom>() -> Value {
let size = core::mem::size_of::<T>();
Value::new(sys::caml_alloc_custom(
T::ops() as *const _ as *const sys::custom_operations,
size,
T::USED,
T::MAX,
))
}
pub unsafe fn alloc_abstract_ptr<T>(ptr: *mut T) -> Value {
let x = Self::alloc(1, Tag::ABSTRACT);
let dest = x.raw().0 as *mut *mut T;
*dest = ptr;
x
}
#[inline]
pub unsafe fn new(v: impl Into<sys::Value>) -> Value {
Value(Root::new(v.into()))
}
pub unsafe fn array_length(&self) -> usize {
sys::caml_array_length(self.raw().into())
}
pub unsafe fn register_global_root(&mut self) {
sys::caml_register_global_root(&mut self.raw().0)
}
pub unsafe fn remove_global_root(&mut self) {
sys::caml_remove_global_root(&mut self.raw().0)
}
pub unsafe fn tag(&self) -> Tag {
sys::tag_val(self.raw().0).into()
}
pub unsafe fn bool(b: bool) -> Value {
Value::int(b as crate::Int)
}
pub unsafe fn string<S: AsRef<str>>(s: S) -> Value {
let s = s.as_ref();
let value = Value::new(sys::caml_alloc_string(s.len()));
let ptr = sys::string_val(value.raw().0);
core::ptr::copy_nonoverlapping(s.as_ptr(), ptr, s.len());
value
}
pub unsafe fn bytes<S: AsRef<[u8]>>(s: S) -> Value {
let s = s.as_ref();
let value = Value::new(sys::caml_alloc_string(s.len()));
let ptr = sys::string_val(value.raw().0);
core::ptr::copy_nonoverlapping(s.as_ptr(), ptr, s.len());
value
}
pub unsafe fn of_str(s: &str) -> Value {
Value::new(s.as_ptr() as isize)
}
pub unsafe fn of_bytes(s: &[u8]) -> Value {
Value::new(s.as_ptr() as isize)
}
pub unsafe fn some<V: IntoValue>(rt: &Runtime, v: V) -> Value {
let v = v.into_value(rt);
let mut x = Value::new(sys::caml_alloc(1, 0));
x.store_field(rt, 0, v);
x
}
#[inline(always)]
pub fn none() -> Value {
unsafe { Value::new(sys::NONE) }
}
#[inline(always)]
pub fn unit() -> Value {
unsafe { Value::new(sys::UNIT) }
}
pub unsafe fn variant(rt: &Runtime, tag: u8, value: Option<Value>) -> Value {
match value {
Some(v) => {
let mut value = Value::new(sys::caml_alloc(1, tag));
value.store_field(rt, 0, v);
value
}
None => Value::new(sys::caml_alloc(0, tag)),
}
}
pub unsafe fn result_ok(rt: &Runtime, value: impl Into<Value>) -> Value {
Self::variant(rt, 0, Some(value.into()))
}
pub unsafe fn result_error(rt: &Runtime, value: impl Into<Value>) -> Value {
Self::variant(rt, 1, Some(value.into()))
}
pub unsafe fn int(i: crate::Int) -> Value {
Value::new(sys::val_int(i))
}
pub unsafe fn uint(i: crate::Uint) -> Value {
Value::new(sys::val_int(i as crate::Int))
}
pub unsafe fn int64(i: i64) -> Value {
Value::new(sys::caml_copy_int64(i))
}
pub unsafe fn int32(i: i32) -> Value {
Value::new(sys::caml_copy_int32(i))
}
pub unsafe fn nativeint(i: isize) -> Value {
Value::new(sys::caml_copy_nativeint(i))
}
pub unsafe fn float(d: f64) -> Value {
Value::new(sys::caml_copy_double(d))
}
pub unsafe fn is_block(&self) -> bool {
sys::is_block(self.raw().0)
}
pub unsafe fn is_long(&self) -> bool {
sys::is_long(self.raw().0)
}
pub unsafe fn field(&self, i: Size) -> Value {
Value::new(*sys::field(self.raw().0, i))
}
pub unsafe fn store_field<V: IntoValue>(&mut self, rt: &Runtime, i: Size, val: V) {
let v = val.into_value(rt);
sys::store_field(self.raw().0, i, v.raw().0)
}
pub unsafe fn int_val(&self) -> isize {
sys::int_val(self.raw().0)
}
pub unsafe fn float_val(&self) -> f64 {
*(self.raw().0 as *const f64)
}
pub unsafe fn int32_val(&self) -> i32 {
*self.custom_ptr_val::<i32>()
}
pub unsafe fn int64_val(&self) -> i64 {
*self.custom_ptr_val::<i64>()
}
pub unsafe fn nativeint_val(&self) -> isize {
*self.custom_ptr_val::<isize>()
}
pub unsafe fn custom_ptr_val<T>(&self) -> *const T {
sys::field(self.raw().0, 1) as *const T
}
pub unsafe fn custom_ptr_val_mut<T>(&mut self) -> *mut T {
sys::field(self.raw().0, 1) as *mut T
}
pub unsafe fn abstract_ptr_val<T>(&self) -> *const T {
*(self.raw().0 as *const *const T)
}
pub unsafe fn abstract_ptr_val_mut<T>(&self) -> *mut T {
*(self.raw().0 as *mut *mut T)
}
pub unsafe fn string_val(&self) -> &str {
let len = sys::caml_string_length(self.raw().0);
let ptr = sys::string_val(self.raw().0);
let slice = ::core::slice::from_raw_parts(ptr, len);
::core::str::from_utf8(slice).expect("Invalid UTF-8")
}
pub unsafe fn bytes_val(&self) -> &[u8] {
let len = sys::caml_string_length(self.raw().0);
let ptr = sys::string_val(self.raw().0);
::core::slice::from_raw_parts(ptr, len)
}
pub unsafe fn string_val_mut(&mut self) -> &mut str {
let len = sys::caml_string_length(self.raw().0);
let ptr = sys::string_val(self.raw().0);
let slice = ::core::slice::from_raw_parts_mut(ptr, len);
::core::str::from_utf8_mut(slice).expect("Invalid UTF-8")
}
pub unsafe fn bytes_val_mut(&mut self) -> &mut [u8] {
let len = sys::caml_string_length(self.raw().0);
let ptr = sys::string_val(self.raw().0);
::core::slice::from_raw_parts_mut(ptr, len)
}
pub unsafe fn exception(&self) -> Option<Value> {
if !self.is_exception_result() {
return None;
}
Some(Value::new(sys::extract_exception(self.raw().0)))
}
pub unsafe fn check_result(mut self) -> Result<Value, Error> {
if !self.is_exception_result() {
return Ok(self);
}
self.0.modify(sys::extract_exception(self.raw().into()));
Err(CamlError::Exception(self).into())
}
pub unsafe fn call<A: IntoValue>(&self, rt: &Runtime, arg1: A) -> Result<Value, Error> {
if self.tag() != Tag::CLOSURE {
return Err(Error::NotCallable);
}
let v = {
let arg1 = arg1.into_value(rt);
Value::new(sys::caml_callback_exn(self.raw().0, arg1.raw().0))
};
v.check_result()
}
pub unsafe fn call2<A: IntoValue, B: IntoValue>(
&self,
rt: &Runtime,
arg1: A,
arg2: B,
) -> Result<Value, Error> {
if self.tag() != Tag::CLOSURE {
return Err(Error::NotCallable);
}
let v = {
let arg1 = arg1.into_value(rt);
let arg2 = arg2.into_value(rt);
Value::new(sys::caml_callback2_exn(
self.raw().0,
arg1.raw().0,
arg2.raw().0,
))
};
v.check_result()
}
pub unsafe fn call3<A: IntoValue, B: IntoValue, C: IntoValue>(
&self,
rt: &Runtime,
arg1: A,
arg2: B,
arg3: C,
) -> Result<Value, Error> {
if self.tag() != Tag::CLOSURE {
return Err(Error::NotCallable);
}
let v = {
let arg1 = arg1.into_value(rt);
let arg2 = arg2.into_value(rt);
let arg3 = arg3.into_value(rt);
Value::new(sys::caml_callback3_exn(
self.raw().0,
arg1.raw().0,
arg2.raw().0,
arg3.raw().0,
))
};
v.check_result()
}
pub unsafe fn call_n<A: AsRef<[Raw]>>(&self, args: A) -> Result<Value, Error> {
if self.tag() != Tag::CLOSURE {
return Err(Error::NotCallable);
}
let n = args.as_ref().len();
let v: Value = Value::new(sys::caml_callbackN_exn(
self.raw().0,
n,
args.as_ref().as_ptr() as *mut sys::Value,
));
v.check_result()
}
pub unsafe fn modify<V: IntoValue>(&mut self, rt: &Runtime, v: V) {
let v = v.into_value(rt);
self.0.modify(v.raw().0);
}
pub unsafe fn is_exception_result(&self) -> bool {
sys::is_exception_result(self.raw().0)
}
pub unsafe fn hash_variant<S: AsRef<str>>(rt: &Runtime, name: S, a: Option<Value>) -> Value {
let s = util::CString::new(name.as_ref()).expect("Invalid C string");
let hash = Value::new(sys::caml_hash_variant(s.as_ptr() as *const u8));
match a {
Some(x) => {
let mut output = Value::alloc_small(2, Tag(0));
output.store_field(rt, 0, hash);
output.store_field(rt, 1, x);
output
}
None => hash,
}
}
pub unsafe fn method<S: AsRef<str>>(&self, rt: &Runtime, name: S) -> Option<Value> {
if self.tag() != Tag::OBJECT {
return None;
}
let variant = Self::hash_variant(rt, name, None);
let v = sys::caml_get_public_method(self.raw().0, variant.raw().0);
if v == 0 {
return None;
}
Some(Value::new(v))
}
pub unsafe fn initialize(&mut self, value: Value) {
sys::caml_initialize(&mut self.raw().0, value.raw().0)
}
#[doc(hidden)]
pub unsafe fn slice<'a>(&self) -> &'a [Raw] {
::core::slice::from_raw_parts(
(self.raw().0 as *const Raw).offset(-1),
sys::wosize_val(self.raw().0) + 1,
)
}
#[doc(hidden)]
pub unsafe fn slice_mut<'a>(&self) -> &'a mut [Raw] {
::core::slice::from_raw_parts_mut(
(self.raw().0 as *mut Raw).offset(-1),
sys::wosize_val(self.raw().0) + 1,
)
}
pub unsafe fn deep_clone_to_ocaml(self) -> Self {
if self.is_long() {
return self;
}
let wosize = sys::wosize_val(self.raw().0);
let val1 = Self::alloc(wosize, self.tag());
let ptr0 = self.raw().0 as *const sys::Value;
let ptr1 = val1.raw().0 as *mut sys::Value;
if self.tag() >= Tag::NO_SCAN {
ptr0.copy_to_nonoverlapping(ptr1, wosize);
return val1;
}
for i in 0..(wosize as isize) {
sys::caml_initialize(
ptr1.offset(i),
Value::new(ptr0.offset(i).read())
.deep_clone_to_ocaml()
.raw()
.0,
);
}
val1
}
#[cfg(not(feature = "no-std"))]
pub unsafe fn deep_clone_to_rust(&self) -> Self {
if self.is_long() {
return self.clone();
}
if self.tag() >= Tag::NO_SCAN {
let slice0 = self.slice();
let vec1 = slice0.to_vec();
let ptr1 = vec1.as_ptr();
core::mem::forget(vec1);
return Value::new(ptr1.offset(1) as isize);
}
let slice0 = self.slice();
Value::new(slice0.as_ptr().offset(1) as isize)
}
}