1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

// Copyright (c) SimpleStaking and Tezedge Contributors
// SPDX-License-Identifier: MIT

use crate::error::{OCamlError, OCamlException};
use crate::memory::{OCamlAllocResult, OCamlAllocToken};
use crate::mlvalues::tag;
use crate::mlvalues::{extract_exception, is_exception_result, tag_val, RawOCaml};
use crate::value::OCaml;

extern "C" {
    fn caml_named_value(name: *const i8) -> *const RawOCaml;

    // fn caml_callback(closure: RawOCaml, arg1: RawOCaml) -> RawOCaml;
    // fn caml_callback2(closure: RawOCaml, arg1: RawOCaml, arg2: RawOCaml) -> RawOCaml;
    // fn caml_callback3(
    //     closure: RawOCaml,
    //     arg1: RawOCaml,
    //     arg2: RawOCaml,
    //     arg3: RawOCaml,
    // ) -> RawOCaml;
    // fn caml_callbackN(closure: RawOCaml, narg: usize, args: *mut RawOCaml) -> RawOCaml;

    fn caml_callback_exn(closure: RawOCaml, arg1: RawOCaml) -> RawOCaml;
    fn caml_callback2_exn(closure: RawOCaml, arg1: RawOCaml, arg2: RawOCaml) -> RawOCaml;
    fn caml_callback3_exn(
        closure: RawOCaml,
        arg1: RawOCaml,
        arg2: RawOCaml,
        arg3: RawOCaml,
    ) -> RawOCaml;
    fn caml_callbackN_exn(closure: RawOCaml, narg: usize, args: *mut RawOCaml) -> RawOCaml;
}

#[derive(Copy, Clone)]
pub struct OCamlClosure(*const RawOCaml);

unsafe impl Sync for OCamlClosure {}

fn get_named(name: &str) -> Option<*const RawOCaml> {
    unsafe {
        let s = match std::ffi::CString::new(name) {
            Ok(s) => s,
            Err(_) => return None,
        };
        let named = caml_named_value(s.as_ptr());
        if named.is_null() {
            return None;
        }

        if tag_val(*named) != tag::CLOSURE {
            return None;
        }

        Some(named)
    }
}

/// The result of calls to OCaml functions. Can be a value or an error.
pub type OCamlResult<T> = Result<OCamlAllocResult<T>, OCamlError>;

/// OCaml function that accepts one argument.
pub type OCamlFn1<A, Ret> = unsafe fn(OCamlAllocToken, OCaml<A>) -> OCamlResult<Ret>;
/// OCaml function that accepts two arguments.
pub type OCamlFn2<A, B, Ret> = unsafe fn(OCamlAllocToken, OCaml<A>, OCaml<B>) -> OCamlResult<Ret>;
/// OCaml function that accepts three arguments.
pub type OCamlFn3<A, B, C, Ret> = unsafe fn(OCamlAllocToken, OCaml<A>, OCaml<B>, OCaml<C>) -> OCamlResult<Ret>;
/// OCaml function that accepts four arguments.
pub type OCamlFn4<A, B, C, D, Ret> = unsafe fn(OCamlAllocToken, OCaml<A>, OCaml<B>, OCaml<C>, OCaml<D>) -> OCamlResult<Ret>;
/// OCaml function that accepts five arguments.
pub type OCamlFn5<A, B, C, D, E, Ret> = unsafe fn(OCamlAllocToken, OCaml<A>, OCaml<B>, OCaml<C>, OCaml<D>, OCaml<E>) -> OCamlResult<Ret>;

impl OCamlClosure {
    pub fn named(name: &str) -> Option<OCamlClosure> {
        get_named(name).map(OCamlClosure)
    }

    pub fn call<T, R>(&self, _token: OCamlAllocToken, arg: OCaml<T>) -> OCamlResult<R> {
        let result = unsafe { caml_callback_exn(*self.0, arg.raw()) };
        self.handle_result(result)
    }

    pub fn call2<T, U, R>(
        &self,
        _token: OCamlAllocToken,
        arg1: OCaml<T>,
        arg2: OCaml<U>,
    ) -> OCamlResult<R> {
        let result = unsafe { caml_callback2_exn(*self.0, arg1.raw(), arg2.raw()) };
        self.handle_result(result)
    }

    pub fn call3<T, U, V, R>(
        &self,
        _token: OCamlAllocToken,
        arg1: OCaml<T>,
        arg2: OCaml<U>,
        arg3: OCaml<V>,
    ) -> OCamlResult<R> {
        let result = unsafe { caml_callback3_exn(*self.0, arg1.raw(), arg2.raw(), arg3.raw()) };
        self.handle_result(result)
    }

    pub fn call_n<R>(&self, _token: OCamlAllocToken, args: &mut [RawOCaml]) -> OCamlResult<R> {
        let len = args.len();
        let result = unsafe { caml_callbackN_exn(*self.0, len, args.as_mut_ptr()) };
        self.handle_result(result)
    }

    #[inline]
    fn handle_result<R>(self, result: RawOCaml) -> OCamlResult<R> {
        if is_exception_result(result) {
            let ex = extract_exception(result);
            Err(OCamlError::Exception(OCamlException::of(ex)))
        } else {
            let gv = OCamlAllocResult::of(result);
            Ok(gv)
        }
    }
}