ocaml_interop/
value.rs

1// Copyright (c) Viable Systems and TezEdge Contributors
2// SPDX-License-Identifier: MIT
3
4use crate::{
5    boxroot::BoxRoot,
6    error::OCamlFixnumConversionError,
7    memory::{alloc_box, OCamlCell},
8    mlvalues::*,
9    FromOCaml, OCamlRef, OCamlRuntime,
10};
11use core::any::Any;
12use core::borrow::Borrow;
13use core::{marker::PhantomData, ops::Deref, slice, str};
14use ocaml_sys::{
15    caml_callback2_exn, caml_callback3_exn, caml_callbackN_exn, caml_callback_exn,
16    caml_string_length, int_val, val_int,
17};
18use std::pin::Pin;
19
20/// Representation of OCaml values.
21pub struct OCaml<'a, T: 'a> {
22    pub(crate) _marker: PhantomData<&'a T>,
23    pub(crate) raw: RawOCaml,
24}
25
26impl<T> Clone for OCaml<'_, T> {
27    fn clone(&self) -> Self {
28        *self
29    }
30}
31
32impl<T> Copy for OCaml<'_, T> {}
33
34impl<T> Deref for OCaml<'_, T> {
35    type Target = OCamlCell<T>;
36
37    fn deref(&self) -> OCamlRef<T> {
38        self.as_ref()
39    }
40}
41
42impl<'a, T> OCaml<'a, T> {
43    #[doc(hidden)]
44    pub unsafe fn new(_cr: &'a OCamlRuntime, x: RawOCaml) -> OCaml<'a, T> {
45        OCaml {
46            _marker: PhantomData,
47            raw: x,
48        }
49    }
50
51    #[doc(hidden)]
52    pub unsafe fn size(&self) -> UIntnat {
53        wosize_val(self.raw)
54    }
55
56    #[doc(hidden)]
57    pub unsafe fn field<F>(&self, i: UIntnat) -> OCaml<'a, F> {
58        assert!(
59            tag_val(self.raw) < tag::NO_SCAN,
60            "unexpected OCaml value tag >= NO_SCAN"
61        );
62        assert!(
63            i < self.size(),
64            "trying to access a field bigger than the OCaml block value"
65        );
66        OCaml {
67            _marker: PhantomData,
68            raw: *(self.raw as *const RawOCaml).add(i),
69        }
70    }
71
72    #[doc(hidden)]
73    pub fn is_block(&self) -> bool {
74        is_block(self.raw)
75    }
76
77    #[doc(hidden)]
78    pub fn is_block_sized(&self, size: usize) -> bool {
79        self.is_block() && unsafe { self.size() == size }
80    }
81
82    #[doc(hidden)]
83    pub fn is_long(&self) -> bool {
84        is_long(self.raw)
85    }
86
87    #[doc(hidden)]
88    pub fn tag_value(&self) -> u8 {
89        assert!(
90            self.is_block(),
91            "attempted to access the tag on an OCaml value that isn't a block"
92        );
93        unsafe { tag_val(self.raw) }
94    }
95
96    /// Obtains an [`OCamlRef`]`<T>` for this value.
97    pub fn as_ref<'b>(&'b self) -> OCamlRef<'b, T>
98    where
99        'a: 'b,
100    {
101        let ptr = &self.raw as *const RawOCaml;
102        unsafe { OCamlCell::create_ref(ptr) }
103    }
104
105    pub fn root(self) -> BoxRoot<T> {
106        BoxRoot::new(self)
107    }
108
109    /// Gets the raw representation for this value reference (pointer or int).
110    ///
111    /// # Safety
112    ///
113    /// The resulting raw pointer will not be tracked, and may become invalid
114    /// after any call into the OCaml runtime. Great care must be taken when
115    /// working with these values.
116    pub unsafe fn raw(&self) -> RawOCaml {
117        self.raw
118    }
119
120    /// Converts this OCaml value into a Rust value.
121    pub fn to_rust<RustT>(&self) -> RustT
122    where
123        RustT: FromOCaml<T>,
124    {
125        RustT::from_ocaml(*self)
126    }
127
128    /// Meant to match Data_custom_val from mlvalues.h
129    ///
130    /// **Experimental**
131    ///
132    /// # Safety
133    ///
134    /// Casts to an arbitrary pointer type, take care before
135    /// dereferencing
136    ///
137    /// Similar to raw(), the resulting pointer can become invalid
138    /// after any call into the OCaml runtime, for example allocating
139    /// OCaml values or calling OCaml functions
140    pub unsafe fn custom_ptr_val<U>(&self) -> *const U {
141        ocaml_sys::field(self.raw, 1) as *const U
142    }
143}
144
145impl<'a, T: 'static> OCaml<'a, DynBox<T>> {
146    /// Build an OCaml value wrapping a Rust value
147    ///
148    /// The returned value will be opaque to the OCaml side, though you
149    /// can provide functions using it and expose them to OCaml.
150    ///
151    /// It will be dropped if it stops being referenced by the GC.
152    ///
153    /// **Experimental**
154    pub fn box_value(cr: &'a mut OCamlRuntime, v: T) -> Self {
155        alloc_box(cr, v)
156    }
157}
158
159impl OCaml<'static, ()> {
160    /// Returns a value that represent OCaml's unit value.
161    pub fn unit() -> Self {
162        OCaml {
163            _marker: PhantomData,
164            raw: UNIT,
165        }
166    }
167}
168
169// Be careful about not deriving anything on OCaml to
170// uphold the Borrow contract on Eq/Ord/Hash
171impl<A: 'static> Borrow<A> for OCaml<'_, DynBox<A>> {
172    fn borrow(&self) -> &A {
173        Pin::get_ref(Pin::as_ref(
174            unsafe { self.custom_ptr_val::<Pin<Box<dyn Any>>>().as_ref() }
175                .expect("Custom block contains null pointer"),
176        ))
177        .downcast_ref::<A>()
178        .expect("DynBox of wrong type, cannot downcast")
179    }
180}
181
182impl<T> OCaml<'static, Option<T>> {
183    /// Returns a value that represent OCaml's None value.
184    pub fn none() -> Self {
185        OCaml {
186            _marker: PhantomData,
187            raw: NONE,
188        }
189    }
190}
191
192impl<'a> OCaml<'a, String> {
193    /// Returns an `[u8]` reference to the internal bytes of this value.
194    pub fn as_bytes(&self) -> &'a [u8] {
195        let s = self.raw;
196        unsafe {
197            assert!(
198                tag_val(s) == tag::STRING,
199                "attempt to perform a string operation on an OCaml value that is not a string"
200            );
201            slice::from_raw_parts(string_val(s), caml_string_length(s))
202        }
203    }
204
205    /// Returns a `str` reference to the internal bytes of this value.
206    ///
207    /// # Panics
208    ///
209    /// Panics if the bytes do not form a valid utf8 string.
210    pub fn as_str(&self) -> &'a str {
211        str::from_utf8(self.as_bytes()).unwrap()
212    }
213
214    /// Returns a `str` reference to the internal bytes of this value.
215    ///
216    /// # Safety
217    ///
218    /// No checks are performed to ensure that the returned value is a valid utf8 string.
219    pub unsafe fn as_str_unchecked(&self) -> &'a str {
220        str::from_utf8_unchecked(self.as_bytes())
221    }
222}
223
224impl<'a> OCaml<'a, OCamlBytes> {
225    /// Returns an `[u8]` reference to the internal bytes of this value.
226    pub fn as_bytes(&self) -> &'a [u8] {
227        let s = self.raw;
228        unsafe {
229            assert!(
230                tag_val(s) == tag::STRING,
231                "attempt to perform a string operation on an OCaml value that is not a string"
232            );
233            slice::from_raw_parts(string_val(s), caml_string_length(s))
234        }
235    }
236
237    /// Returns a `str` reference to the internal bytes of this value.
238    ///
239    /// # Panics
240    ///
241    /// Panics if the bytes do not form a valid utf8 string.
242    pub fn as_str(&self) -> &'a str {
243        str::from_utf8(self.as_bytes()).unwrap()
244    }
245
246    /// Returns a `str` reference to the internal bytes of this value.
247    ///
248    /// # Safety
249    ///
250    /// No checks are performed to ensure that the returned value is a valid utf8 string.
251    pub unsafe fn as_str_unchecked(&self) -> &'a str {
252        str::from_utf8_unchecked(self.as_bytes())
253    }
254}
255
256impl OCaml<'_, OCamlInt> {
257    /// Converts an OCaml int to an `i64`.
258    pub fn to_i64(&self) -> i64 {
259        unsafe { int_val(self.raw) as i64 }
260    }
261
262    /// Creates an OCaml int from an `i64` without checking that it fits in an OCaml fixnum.
263    ///
264    /// # Safety
265    ///
266    /// OCaml ints are represented as 63bits + 1bit tag, so when converting
267    /// from an i64, a bit of precision is lost.
268    pub unsafe fn of_i64_unchecked(n: i64) -> OCaml<'static, OCamlInt> {
269        OCaml {
270            _marker: PhantomData,
271            raw: val_int(n as isize),
272        }
273    }
274
275    // Creates an OCaml int from an `i64`.
276    //
277    // The conversion fails if the `i64` value doesn't fit in an OCaml fixnum and
278    // an error is returned instead.
279    pub fn of_i64(n: i64) -> Result<OCaml<'static, OCamlInt>, OCamlFixnumConversionError> {
280        if n > MAX_FIXNUM as i64 {
281            Err(OCamlFixnumConversionError::InputTooBig(n))
282        } else if n < MIN_FIXNUM as i64 {
283            Err(OCamlFixnumConversionError::InputTooSmall(n))
284        } else {
285            Ok(OCaml {
286                _marker: PhantomData,
287                raw: unsafe { val_int(n as isize) },
288            })
289        }
290    }
291
292    /// Creates an OCaml int from an i32.
293    pub fn of_i32(n: i32) -> OCaml<'static, OCamlInt> {
294        OCaml {
295            _marker: PhantomData,
296            raw: unsafe { val_int(n as isize) },
297        }
298    }
299}
300
301impl OCaml<'_, bool> {
302    /// Converts an OCaml boolean into a Rust boolean.
303    pub fn to_bool(&self) -> bool {
304        unsafe { int_val(self.raw) != 0 }
305    }
306
307    /// Creates an OCaml boolean from a Rust boolean.
308    pub fn of_bool(b: bool) -> OCaml<'static, bool> {
309        OCaml {
310            _marker: PhantomData,
311            raw: if b { TRUE } else { FALSE },
312        }
313    }
314}
315
316impl<'a, A> OCaml<'a, Option<A>> {
317    /// Returns true if this OCaml option value is an OCaml `None`.
318    pub fn is_none(&self) -> bool {
319        self.raw == NONE
320    }
321
322    /// Returns true if this OCaml option value is an OCaml `Some`.
323    pub fn is_some(&self) -> bool {
324        self.is_block()
325    }
326
327    /// Converts an OCaml `Option<T>` value into a Rust `Option<OCaml<T>>`.
328    pub fn to_option(&self) -> Option<OCaml<'a, A>> {
329        if self.is_none() {
330            None
331        } else {
332            let value: OCaml<A> = unsafe { self.field(0) };
333            Some(OCaml {
334                _marker: PhantomData,
335                raw: value.raw,
336            })
337        }
338    }
339}
340
341impl<'a, A, Err> OCaml<'a, Result<A, Err>> {
342    /// Returns true if this OCaml result value is an OCaml `Ok`.
343    pub fn is_ok(&self) -> bool {
344        self.tag_value() == tag::TAG_OK
345    }
346
347    /// Returns true if this OCaml result value is an OCaml `Error`.
348    pub fn is_error(&self) -> bool {
349        self.tag_value() == tag::TAG_ERROR
350    }
351
352    /// Converts an OCaml `Result<T, E>` value into a Rust `Result<OCaml<T>, OCaml<E>>`.
353    pub fn to_result(&self) -> Result<OCaml<'a, A>, OCaml<'a, Err>> {
354        if self.is_ok() {
355            let value: OCaml<A> = unsafe { self.field(0) };
356            Ok(OCaml {
357                _marker: PhantomData,
358                raw: value.raw,
359            })
360        } else if self.is_error() {
361            let value: OCaml<Err> = unsafe { self.field(0) };
362            Err(OCaml {
363                _marker: PhantomData,
364                raw: value.raw,
365            })
366        } else {
367            panic!(
368                "Unexpected tag value for OCaml<Result<...>>: {}",
369                self.tag_value()
370            )
371        }
372    }
373}
374
375impl<'a, A> OCaml<'a, OCamlList<A>> {
376    /// Returns an OCaml nil (empty list) value.
377    pub fn nil(_: &'a mut OCamlRuntime) -> Self {
378        OCaml {
379            _marker: PhantomData,
380            raw: EMPTY_LIST,
381        }
382    }
383
384    /// Returns true if the value is OCaml's nil (empty list).
385    pub fn is_empty(&self) -> bool {
386        self.raw == EMPTY_LIST
387    }
388
389    /// Returns the head of an OCaml list.
390    pub fn hd(&self) -> Option<OCaml<'a, A>> {
391        if self.is_empty() {
392            None
393        } else {
394            Some(unsafe { self.field(0) })
395        }
396    }
397
398    /// Returns the tail of an OCaml list.
399    pub fn tl(&self) -> Option<OCaml<'a, OCamlList<A>>> {
400        if self.is_empty() {
401            None
402        } else {
403            Some(unsafe { self.field(1) })
404        }
405    }
406
407    /// Returns a tuple of the head and tail of an OCaml list.
408    pub fn uncons(&self) -> Option<(OCaml<'a, A>, Self)> {
409        if self.is_empty() {
410            None
411        } else {
412            Some(unsafe { (self.field(0), self.field(1)) })
413        }
414    }
415}
416
417// Tuples
418
419macro_rules! impl_tuple {
420    ($($n:tt: $accessor:ident -> $t:ident),+) => {
421        impl<'a, $($t),+> OCaml<'a, ($($t),+)>
422        {
423            pub fn to_tuple(&self) -> ($(OCaml<'a, $t>),+) {
424                ($(self.$accessor()),+)
425            }
426
427            $(
428                pub fn $accessor(&self) -> OCaml<'a, $t> {
429                    unsafe { self.field($n) }
430                }
431            )+
432        }
433    };
434}
435
436impl_tuple!(
437    0: fst -> A,
438    1: snd -> B);
439impl_tuple!(
440    0: fst -> A,
441    1: snd -> B,
442    2: tuple_3 -> C);
443impl_tuple!(
444    0: fst -> A,
445    1: snd -> B,
446    2: tuple_3 -> C,
447    3: tuple_4 -> D);
448impl_tuple!(
449    0: fst -> A,
450    1: snd -> B,
451    2: tuple_3 -> C,
452    3: tuple_4 -> D,
453    4: tuple_5 -> E);
454impl_tuple!(
455    0: fst -> A,
456    1: snd -> B,
457    2: tuple_3 -> C,
458    3: tuple_4 -> D,
459    4: tuple_5 -> E,
460    5: tuple_6 -> F);
461impl_tuple!(
462    0: fst -> A,
463    1: snd -> B,
464    2: tuple_3 -> C,
465    3: tuple_4 -> D,
466    4: tuple_5 -> E,
467    5: tuple_6 -> F,
468    6: tuple_7 -> G);
469impl_tuple!(
470    0: fst -> A,
471    1: snd -> B,
472    2: tuple_3 -> C,
473    3: tuple_4 -> D,
474    4: tuple_5 -> E,
475    5: tuple_6 -> F,
476    6: tuple_7 -> G,
477    7: tuple_8 -> H);
478impl_tuple!(
479    0: fst -> A,
480    1: snd -> B,
481    2: tuple_3 -> C,
482    3: tuple_4 -> D,
483    4: tuple_5 -> E,
484    5: tuple_6 -> F,
485    6: tuple_7 -> G,
486    7: tuple_8 -> H,
487    8: tuple_9 -> I);
488
489impl<A: bigarray::BigarrayElt> OCaml<'_, bigarray::Array1<A>> {
490    /// Returns the number of items in `self`
491    pub fn len(&self) -> usize {
492        let ba = unsafe { self.custom_ptr_val::<ocaml_sys::bigarray::Bigarray>() };
493        unsafe { *((*ba).dim.as_ptr() as *const usize) }
494    }
495
496    /// Returns true when `self.len() == 0`
497    pub fn is_empty(&self) -> bool {
498        self.len() == 0
499    }
500
501    /// Get underlying data as Rust slice
502    pub fn as_slice(&self) -> &[A] {
503        unsafe {
504            let ba = self.custom_ptr_val::<ocaml_sys::bigarray::Bigarray>();
505            slice::from_raw_parts((*ba).data as *const A, self.len())
506        }
507    }
508}
509
510impl<'a> OCaml<'a, OCamlException> {
511    #[doc(hidden)]
512    pub unsafe fn of_exception_result(
513        cr: &'a OCamlRuntime,
514        exception_result: RawOCaml,
515    ) -> Option<OCaml<'a, OCamlException>> {
516        if is_exception_result(exception_result) {
517            Some(OCaml::new(cr, extract_exception(exception_result)))
518        } else {
519            None
520        }
521    }
522
523    /// If the exception has a single argument of type string, extracts and
524    /// returns it. Examples of such exceptions are `Failure of string`
525    /// (raised via the `failwith` OCaml function, or the
526    /// `caml_raise_with_string` C function) or `Invalid_argument of string`.
527    pub fn message(&self) -> Option<String> {
528        if self.is_block_sized(2) && self.tag_value() == tag::TAG_EXCEPTION {
529            let exn_argument: OCaml<String> = unsafe { self.field(1) };
530            if exn_argument.is_block() && exn_argument.tag_value() == tag::STRING {
531                Some(exn_argument.to_rust())
532            } else {
533                None
534            }
535        } else {
536            None
537        }
538    }
539}
540
541// Functions
542
543pub enum RefOrRooted<'a, 'b, T: 'static> {
544    Ref(&'a OCamlRef<'b, T>),
545    Root(BoxRoot<T>),
546}
547
548impl<T: 'static> RefOrRooted<'_, '_, T> {
549    unsafe fn get_raw(&self) -> RawOCaml {
550        match self {
551            RefOrRooted::Ref(a) => a.get_raw(),
552            RefOrRooted::Root(a) => a.get_raw(),
553        }
554    }
555}
556
557pub trait OCamlParam<'a, 'b, RustValue, OCamlValue> {
558    fn to_rooted(self, cr: &mut OCamlRuntime) -> RefOrRooted<'a, 'b, OCamlValue>;
559}
560
561impl<'a, 'b, OCamlValue> OCamlParam<'a, 'b, (), OCamlValue> for &'a OCamlRef<'b, OCamlValue> {
562    fn to_rooted(self, _: &mut OCamlRuntime) -> RefOrRooted<'a, 'b, OCamlValue> {
563        RefOrRooted::Ref(self)
564    }
565}
566
567impl<'a, 'b, RustValue, OCamlValue> OCamlParam<'a, 'b, RustValue, OCamlValue> for &RustValue
568where
569    RustValue: crate::ToOCaml<OCamlValue>,
570{
571    fn to_rooted(self, cr: &mut OCamlRuntime) -> RefOrRooted<'a, 'b, OCamlValue> {
572        let boxroot = self.to_boxroot(cr);
573        RefOrRooted::Root(boxroot)
574    }
575}
576
577macro_rules! try_call_impl {
578    (
579        $( { $method:ident, ($( ($argname:ident: $ot:ident $rt:ident) ),*) } ),*,
580        NPARAMS:
581        $( { $( ($argname2:ident: $ot2:ident $rt2:ident) ),* } ),*,
582    ) => {
583        $(
584            #[allow(non_camel_case_types)]
585            impl<'c, $($ot),+, RetT> BoxRoot<fn($($ot,)+) -> RetT> {
586                /// Calls the OCaml closure, converting the arguments to OCaml if necessary
587                pub fn try_call<'a, 'b: 'a, $($argname),* $(,$rt)* >(
588                    &self,
589                    cr: &'c mut OCamlRuntime,
590                    $($argname: $argname),+
591                ) -> Result<OCaml<'c, RetT>, OCaml<'c, OCamlException>>
592                where
593                    $($argname: OCamlParam<'a, 'b, $rt, $ot>),+
594                {
595                    $(let $argname = $argname.to_rooted(cr);)*
596
597                    let result = unsafe { $method(self.get_raw(), $($argname.get_raw()),+) };
598                    match unsafe { OCaml::of_exception_result(cr, result) } {
599                        Some(ex) => Err(ex),
600                        None => Ok(unsafe { OCaml::new(cr, result) })
601                    }
602                }
603            }
604        )*
605        $(
606            #[allow(clippy::too_many_arguments)]
607            #[allow(non_camel_case_types)]
608            impl<'c, $($ot2,)* RetT> BoxRoot<fn($($ot2,)*) -> RetT> {
609                /// Calls the OCaml closure, converting the arguments to OCaml if necessary
610                pub fn try_call<'a, 'b: 'a, $($argname2),* $(,$rt2)* >(
611                    &self,
612                    cr: &'c mut OCamlRuntime,
613                    $($argname2: $argname2),*
614                ) -> Result<OCaml<'c, RetT>, OCaml<'c, OCamlException>>
615                where
616                    $($argname2: OCamlParam<'a, 'b, $rt2, $ot2>),*
617                {
618                    $(let $argname2 = $argname2.to_rooted(cr);)*
619
620                    let mut args = unsafe {
621                        [$($argname2.get_raw()),*]
622                    };
623
624                    let result = unsafe { caml_callbackN_exn(self.get_raw(), args.len(), args.as_mut_ptr()) };
625                    match unsafe { OCaml::of_exception_result(cr, result) } {
626                        Some(ex) => Err(ex),
627                        None => Ok(unsafe { OCaml::new(cr, result) })
628                    }
629                }
630            }
631        )*
632    }
633}
634
635try_call_impl! {
636    { caml_callback_exn, ((arg1: OCaml1 Rust1)) },
637    { caml_callback2_exn, ((arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2)) },
638    { caml_callback3_exn, ((arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2), (arg3: OCaml3 Rust3)) },
639    NPARAMS:
640    { (arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2), (arg3: OCaml3 Rust3), (arg4: OCaml4 Rust4) },
641    { (arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2), (arg3: OCaml3 Rust3), (arg4: OCaml4 Rust4),
642       (arg5: OCaml5 Rust5) },
643    { (arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2), (arg3: OCaml3 Rust3), (arg4: OCaml4 Rust4),
644       (arg5: OCaml5 Rust5), (arg6: OCaml6 Rust6) },
645    { (arg1: OCaml1 Rust1), (arg2: OCaml2 Rust2), (arg3: OCaml3 Rust3), (arg4: OCaml4 Rust4),
646       (arg5: OCaml5 Rust5), (arg6: OCaml6 Rust6), (arg7: OCaml7 Rust7) },
647}
ocaml_interop/value.rs

ocaml_interop/
value.rs
