Skip to main content

native/rx_rust_nif/src/r_api.rs 

use libc::{c_char, c_int, c_void};
use libloading::{Library, Symbol};
use std::ffi::{CString, NulError};
use std::path::Path;

pub type Sexp = *mut c_void;
pub type Rboolean = c_int;

pub const NILSXP: c_int = 0;
pub const LGLSXP: c_int = 10;
pub const INTSXP: c_int = 13;
pub const REALSXP: c_int = 14;
pub const STRSXP: c_int = 16;
#[allow(dead_code)]
pub const VECSXP: c_int = 19;
pub const RAWSXP: c_int = 24;

#[allow(dead_code)]
pub const R_NA_INT: c_int = i32::MIN;
pub const CE_UTF8: c_int = 1;

#[repr(C)]
#[allow(dead_code)]
#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub enum ParseStatus {
    Null = 0,
    Ok = 1,
    Incomplete = 2,
    Error = 3,
    Eof = 4,
}

pub struct RApi {
    lib: Library,
    pub rf_initialize_r: unsafe extern "C" fn(c_int, *mut *mut c_char) -> c_int,
    pub setup_rmainloop: unsafe extern "C" fn(),
    pub mk_string: unsafe extern "C" fn(*const c_char) -> Sexp,
    pub protect: unsafe extern "C" fn(Sexp) -> Sexp,
    pub unprotect: unsafe extern "C" fn(c_int),
    pub parse_vector: unsafe extern "C" fn(Sexp, c_int, *mut ParseStatus, Sexp) -> Sexp,
    pub try_eval: unsafe extern "C" fn(Sexp, Sexp, *mut c_int) -> Sexp,
    #[allow(dead_code)]
    pub toplevel_exec:
        unsafe extern "C" fn(unsafe extern "C" fn(*mut c_void), *mut c_void) -> Rboolean,
    pub xlength: unsafe extern "C" fn(Sexp) -> isize,
    pub length: unsafe extern "C" fn(Sexp) -> c_int,
    pub vector_elt: unsafe extern "C" fn(Sexp, isize) -> Sexp,
    pub type_of: unsafe extern "C" fn(Sexp) -> c_int,
    pub logical_elt: unsafe extern "C" fn(Sexp, isize) -> c_int,
    pub real_elt: unsafe extern "C" fn(Sexp, isize) -> f64,
    pub integer_elt: unsafe extern "C" fn(Sexp, isize) -> c_int,
    pub string_elt: unsafe extern "C" fn(Sexp, isize) -> Sexp,
    pub r_char: unsafe extern "C" fn(Sexp) -> *const c_char,
    pub preserve_object: unsafe extern "C" fn(Sexp),
    pub release_object: unsafe extern "C" fn(Sexp),
    pub scalar_real: unsafe extern "C" fn(f64) -> Sexp,
    pub scalar_integer: unsafe extern "C" fn(c_int) -> Sexp,
    pub scalar_logical: unsafe extern "C" fn(c_int) -> Sexp,
    pub alloc_vector: unsafe extern "C" fn(c_int, isize) -> Sexp,
    pub raw: unsafe extern "C" fn(Sexp) -> *mut u8,
    pub mk_char_len_ce: unsafe extern "C" fn(*const c_char, c_int, c_int) -> Sexp,
    pub scalar_string: unsafe extern "C" fn(Sexp) -> Sexp,
    pub set_vector_elt: unsafe extern "C" fn(Sexp, isize, Sexp) -> Sexp,
    pub set_attrib: unsafe extern "C" fn(Sexp, Sexp, Sexp) -> Sexp,
    pub set_integer_elt: unsafe extern "C" fn(Sexp, isize, c_int),
    pub set_real_elt: unsafe extern "C" fn(Sexp, isize, f64),
    pub set_logical_elt: unsafe extern "C" fn(Sexp, isize, c_int),
    pub set_string_elt: unsafe extern "C" fn(Sexp, isize, Sexp),
    pub install: unsafe extern "C" fn(*const c_char) -> Sexp,
    pub define_var: unsafe extern "C" fn(Sexp, Sexp, Sexp),
    pub find_var_in_frame: unsafe extern "C" fn(Sexp, Sexp) -> Sexp,
    pub ls_internal: unsafe extern "C" fn(Sexp, Rboolean) -> Sexp,
    pub new_env: unsafe extern "C" fn(Sexp, c_int, c_int) -> Sexp,
    pub lang1: unsafe extern "C" fn(Sexp) -> Sexp,
    pub lang2: unsafe extern "C" fn(Sexp, Sexp) -> Sexp,
    pub lang3: unsafe extern "C" fn(Sexp, Sexp, Sexp) -> Sexp,
    pub lang4: unsafe extern "C" fn(Sexp, Sexp, Sexp, Sexp) -> Sexp,
    pub get_attrib: unsafe extern "C" fn(Sexp, Sexp) -> Sexp,
    pub nil_value: *mut Sexp,
    pub global_env: *mut Sexp,
    pub names_symbol: *mut Sexp,
    pub class_symbol: *mut Sexp,
    pub dim_symbol: *mut Sexp,
    pub na_string: *mut Sexp,
    pub na_int: *mut c_int,
    pub na_real: *mut f64,
}

impl RApi {
    pub unsafe fn load(path: &str) -> Result<Self, String> {
        if !Path::new(path).exists() {
            return Err(format!("libR path does not exist: {path}"));
        }

        #[cfg(unix)]
        let lib: Library =
            libloading::os::unix::Library::open(Some(path), libc::RTLD_NOW | libc::RTLD_GLOBAL)
                .map_err(|error| format!("failed to dlopen libR: {error}"))?
                .into();

        #[cfg(not(unix))]
        return Err("Rust native NIF currently requires a Unix-like libR loader".to_owned());

        macro_rules! sym {
            ($name:literal, $ty:ty) => {{
                let symbol: Symbol<$ty> = lib.get($name).map_err(|error| {
                    format!(
                        "libR is missing {}: {error}",
                        String::from_utf8_lossy($name)
                    )
                })?;
                *symbol
            }};
        }

        Ok(Self {
            rf_initialize_r: sym!(
                b"Rf_initialize_R",
                unsafe extern "C" fn(c_int, *mut *mut c_char) -> c_int
            ),
            setup_rmainloop: sym!(b"setup_Rmainloop", unsafe extern "C" fn()),
            mk_string: sym!(b"Rf_mkString", unsafe extern "C" fn(*const c_char) -> Sexp),
            protect: sym!(b"Rf_protect", unsafe extern "C" fn(Sexp) -> Sexp),
            unprotect: sym!(b"Rf_unprotect", unsafe extern "C" fn(c_int)),
            parse_vector: sym!(
                b"R_ParseVector",
                unsafe extern "C" fn(Sexp, c_int, *mut ParseStatus, Sexp) -> Sexp
            ),
            try_eval: sym!(
                b"R_tryEval",
                unsafe extern "C" fn(Sexp, Sexp, *mut c_int) -> Sexp
            ),
            toplevel_exec: sym!(
                b"R_ToplevelExec",
                unsafe extern "C" fn(unsafe extern "C" fn(*mut c_void), *mut c_void) -> Rboolean
            ),
            xlength: sym!(b"Rf_xlength", unsafe extern "C" fn(Sexp) -> isize),
            length: sym!(b"LENGTH", unsafe extern "C" fn(Sexp) -> c_int),
            vector_elt: sym!(b"VECTOR_ELT", unsafe extern "C" fn(Sexp, isize) -> Sexp),
            type_of: sym!(b"TYPEOF", unsafe extern "C" fn(Sexp) -> c_int),
            logical_elt: sym!(b"LOGICAL_ELT", unsafe extern "C" fn(Sexp, isize) -> c_int),
            real_elt: sym!(b"REAL_ELT", unsafe extern "C" fn(Sexp, isize) -> f64),
            integer_elt: sym!(b"INTEGER_ELT", unsafe extern "C" fn(Sexp, isize) -> c_int),
            string_elt: sym!(b"STRING_ELT", unsafe extern "C" fn(Sexp, isize) -> Sexp),
            r_char: sym!(b"R_CHAR", unsafe extern "C" fn(Sexp) -> *const c_char),
            preserve_object: sym!(b"R_PreserveObject", unsafe extern "C" fn(Sexp)),
            release_object: sym!(b"R_ReleaseObject", unsafe extern "C" fn(Sexp)),
            scalar_real: sym!(b"Rf_ScalarReal", unsafe extern "C" fn(f64) -> Sexp),
            scalar_integer: sym!(b"Rf_ScalarInteger", unsafe extern "C" fn(c_int) -> Sexp),
            scalar_logical: sym!(b"Rf_ScalarLogical", unsafe extern "C" fn(c_int) -> Sexp),
            alloc_vector: sym!(
                b"Rf_allocVector",
                unsafe extern "C" fn(c_int, isize) -> Sexp
            ),
            raw: sym!(b"RAW", unsafe extern "C" fn(Sexp) -> *mut u8),
            mk_char_len_ce: sym!(
                b"Rf_mkCharLenCE",
                unsafe extern "C" fn(*const c_char, c_int, c_int) -> Sexp
            ),
            scalar_string: sym!(b"Rf_ScalarString", unsafe extern "C" fn(Sexp) -> Sexp),
            set_vector_elt: sym!(
                b"SET_VECTOR_ELT",
                unsafe extern "C" fn(Sexp, isize, Sexp) -> Sexp
            ),
            set_attrib: sym!(
                b"Rf_setAttrib",
                unsafe extern "C" fn(Sexp, Sexp, Sexp) -> Sexp
            ),
            set_integer_elt: sym!(b"SET_INTEGER_ELT", unsafe extern "C" fn(Sexp, isize, c_int)),
            set_real_elt: sym!(b"SET_REAL_ELT", unsafe extern "C" fn(Sexp, isize, f64)),
            set_logical_elt: sym!(b"SET_LOGICAL_ELT", unsafe extern "C" fn(Sexp, isize, c_int)),
            set_string_elt: sym!(b"SET_STRING_ELT", unsafe extern "C" fn(Sexp, isize, Sexp)),
            install: sym!(b"Rf_install", unsafe extern "C" fn(*const c_char) -> Sexp),
            define_var: sym!(b"Rf_defineVar", unsafe extern "C" fn(Sexp, Sexp, Sexp)),
            find_var_in_frame: sym!(
                b"Rf_findVarInFrame",
                unsafe extern "C" fn(Sexp, Sexp) -> Sexp
            ),
            ls_internal: sym!(
                b"R_lsInternal",
                unsafe extern "C" fn(Sexp, Rboolean) -> Sexp
            ),
            new_env: sym!(
                b"R_NewEnv",
                unsafe extern "C" fn(Sexp, c_int, c_int) -> Sexp
            ),
            lang1: sym!(b"Rf_lang1", unsafe extern "C" fn(Sexp) -> Sexp),
            lang2: sym!(b"Rf_lang2", unsafe extern "C" fn(Sexp, Sexp) -> Sexp),
            lang3: sym!(b"Rf_lang3", unsafe extern "C" fn(Sexp, Sexp, Sexp) -> Sexp),
            lang4: sym!(
                b"Rf_lang4",
                unsafe extern "C" fn(Sexp, Sexp, Sexp, Sexp) -> Sexp
            ),
            get_attrib: sym!(b"Rf_getAttrib", unsafe extern "C" fn(Sexp, Sexp) -> Sexp),
            nil_value: sym!(b"R_NilValue", *mut Sexp),
            global_env: sym!(b"R_GlobalEnv", *mut Sexp),
            names_symbol: sym!(b"R_NamesSymbol", *mut Sexp),
            class_symbol: sym!(b"R_ClassSymbol", *mut Sexp),
            dim_symbol: sym!(b"R_DimSymbol", *mut Sexp),
            na_string: sym!(b"R_NaString", *mut Sexp),
            na_int: sym!(b"R_NaInt", *mut c_int),
            na_real: sym!(b"R_NaReal", *mut f64),
            lib,
        })
    }

    pub unsafe fn configure_c_stack(&self) {
        let stack_anchor = 0usize;

        if let Ok(symbol) = self.lib.get::<*mut usize>(b"R_CStackStart") {
            if !(*symbol).is_null() {
                **symbol = &stack_anchor as *const usize as usize;
            }
        }

        if let Ok(symbol) = self.lib.get::<*mut usize>(b"R_CStackLimit") {
            if !(*symbol).is_null() {
                **symbol = usize::MAX;
            }
        }

        if let Ok(symbol) = self.lib.get::<*mut c_int>(b"R_CStackDir") {
            if !(*symbol).is_null() {
                **symbol = -1;
            }
        }
    }
}

pub fn c_string(value: &str) -> Result<CString, NulError> {
    CString::new(value.as_bytes())
}