diff --git a/R-package/R/000-wrappers.R b/R-package/R/000-wrappers.R index e79f0295..098b4d9b 100644 --- a/R-package/R/000-wrappers.R +++ b/R-package/R/000-wrappers.R @@ -441,6 +441,21 @@ foo_a <- function() { } +get_var_in_env <- function(name, env = NULL) { + .Call(savvy_get_var_in_env__impl, name, env) +} + + +var_exists_in_env <- function(name, env = NULL) { + .Call(savvy_var_exists_in_env__impl, name, env) +} + + +set_var_in_env <- function(name, value, env = NULL) { + invisible(.Call(savvy_set_var_in_env__impl, name, value, env)) +} + + get_foo_value <- function() { .Call(savvy_get_foo_value__impl) } diff --git a/R-package/src/init.c b/R-package/src/init.c index e3403008..a80cf319 100644 --- a/R-package/src/init.c +++ b/R-package/src/init.c @@ -414,6 +414,21 @@ SEXP savvy_foo_a__impl(void) { return handle_result(res); } +SEXP savvy_get_var_in_env__impl(SEXP name, SEXP env) { + SEXP res = savvy_get_var_in_env__ffi(name, env); + return handle_result(res); +} + +SEXP savvy_var_exists_in_env__impl(SEXP name, SEXP env) { + SEXP res = savvy_var_exists_in_env__ffi(name, env); + return handle_result(res); +} + +SEXP savvy_set_var_in_env__impl(SEXP name, SEXP value, SEXP env) { + SEXP res = savvy_set_var_in_env__ffi(name, value, env); + return handle_result(res); +} + SEXP savvy_init_foo_value__impl(DllInfo* dll) { SEXP res = savvy_init_foo_value__ffi(dll); return handle_result(res); @@ -726,6 +741,9 @@ static const R_CallMethodDef CallEntries[] = { {"savvy_print_foo_enum__impl", (DL_FUNC) &savvy_print_foo_enum__impl, 1}, {"savvy_print_foo_enum_ref__impl", (DL_FUNC) &savvy_print_foo_enum_ref__impl, 1}, {"savvy_foo_a__impl", (DL_FUNC) &savvy_foo_a__impl, 0}, + {"savvy_get_var_in_env__impl", (DL_FUNC) &savvy_get_var_in_env__impl, 2}, + {"savvy_var_exists_in_env__impl", (DL_FUNC) &savvy_var_exists_in_env__impl, 2}, + {"savvy_set_var_in_env__impl", (DL_FUNC) &savvy_set_var_in_env__impl, 3}, {"savvy_get_foo_value__impl", (DL_FUNC) &savvy_get_foo_value__impl, 0}, {"savvy_safe_stop__impl", (DL_FUNC) &savvy_safe_stop__impl, 0}, {"savvy_raise_error__impl", (DL_FUNC) &savvy_raise_error__impl, 0}, diff --git a/R-package/src/rust/api.h b/R-package/src/rust/api.h index 82b77f91..18e9b32b 100644 --- a/R-package/src/rust/api.h +++ b/R-package/src/rust/api.h @@ -74,6 +74,9 @@ SEXP savvy_rep_str_slice__ffi(SEXP x); SEXP savvy_print_foo_enum__ffi(SEXP x); SEXP savvy_print_foo_enum_ref__ffi(SEXP x); SEXP savvy_foo_a__ffi(void); +SEXP savvy_get_var_in_env__ffi(SEXP name, SEXP env); +SEXP savvy_var_exists_in_env__ffi(SEXP name, SEXP env); +SEXP savvy_set_var_in_env__ffi(SEXP name, SEXP value, SEXP env); SEXP savvy_init_foo_value__ffi(DllInfo* dll); SEXP savvy_get_foo_value__ffi(void); SEXP savvy_safe_stop__ffi(void); diff --git a/R-package/src/rust/src/environment.rs b/R-package/src/rust/src/environment.rs new file mode 100644 index 00000000..bacce9b9 --- /dev/null +++ b/R-package/src/rust/src/environment.rs @@ -0,0 +1,20 @@ +use savvy::{savvy, EnvironmentSexp, Sexp}; + +#[savvy] +fn get_var_in_env(name: &str, env: Option) -> savvy::Result { + let env = env.unwrap_or(EnvironmentSexp::global_env()); + let obj = env.get(name)?; + obj.ok_or("Not found".into()) +} + +#[savvy] +fn var_exists_in_env(name: &str, env: Option) -> savvy::Result { + let env = env.unwrap_or(EnvironmentSexp::global_env()); + env.contains(name)?.try_into() +} + +#[savvy] +fn set_var_in_env(name: &str, value: Sexp, env: Option) -> savvy::Result<()> { + let env = env.unwrap_or(EnvironmentSexp::global_env()); + env.set(name, value) +} diff --git a/R-package/src/rust/src/lib.rs b/R-package/src/rust/src/lib.rs index 39961b6e..365454a8 100644 --- a/R-package/src/rust/src/lib.rs +++ b/R-package/src/rust/src/lib.rs @@ -6,6 +6,7 @@ mod complex; mod consuming_type; mod convert_from_rust_types; mod enum_support; +mod environment; mod error_handling; mod function; mod init_vectors; diff --git a/R-package/tests/testthat/test-environment.R b/R-package/tests/testthat/test-environment.R new file mode 100644 index 00000000..102d0906 --- /dev/null +++ b/R-package/tests/testthat/test-environment.R @@ -0,0 +1,24 @@ +test_that("environment", { + e1 <- new.env(parent = emptyenv()) + e1$a <- "foo" + + expect_true(var_exists_in_env("a", e1)) + expect_false(var_exists_in_env("b", e1)) + + expect_equal(get_var_in_env("a", e1), "foo") + expect_error(get_var_in_env("b", e1)) + + # doesn't climb up the parent environments + e2 <- new.env(parent = e1) + expect_false(var_exists_in_env("a", e2)) + + set_var_in_env("c", 100L, e1) + expect_equal(e1$c, 100L) + # overwrite + set_var_in_env("c", 300L, e1) + expect_equal(e1$c, 300L) + + # global env + .GlobalEnv$global_obj <- "ABC" + expect_equal(get_var_in_env("global_obj"), "ABC") +}) diff --git a/savvy-bindgen/src/ir/savvy_fn.rs b/savvy-bindgen/src/ir/savvy_fn.rs index c94f320b..b4d4d6ea 100644 --- a/savvy-bindgen/src/ir/savvy_fn.rs +++ b/savvy-bindgen/src/ir/savvy_fn.rs @@ -92,7 +92,8 @@ impl SavvyInputType { // Read-only types "Sexp" | "IntegerSexp" | "RealSexp" | "NumericSexp" | "ComplexSexp" - | "LogicalSexp" | "StringSexp" | "ListSexp" | "FunctionSexp" => Ok(Self { + | "LogicalSexp" | "StringSexp" | "ListSexp" | "FunctionSexp" + | "EnvironmentSexp" => Ok(Self { category: SavvyInputTypeCategory::SexpWrapper, ty_orig: ty.clone(), ty_str, diff --git a/savvy-ffi/src/lib.rs b/savvy-ffi/src/lib.rs index 7fa9c86d..f0004813 100644 --- a/savvy-ffi/src/lib.rs +++ b/savvy-ffi/src/lib.rs @@ -206,8 +206,11 @@ extern "C" { pub fn Rf_isFunction(arg1: SEXP) -> Rboolean; pub fn Rf_isEnvironment(arg1: SEXP) -> Rboolean; pub fn Rf_eval(arg1: SEXP, arg2: SEXP) -> SEXP; + pub fn Rf_defineVar(arg1: SEXP, arg2: SEXP, arg3: SEXP); + pub fn Rf_findVarInFrame3(arg1: SEXP, arg2: SEXP, arg3: Rboolean) -> SEXP; pub static mut R_GlobalEnv: SEXP; + pub static mut R_UnboundValue: SEXP; } // Parse diff --git a/src/lib.rs b/src/lib.rs index 3209ebd3..318518e7 100644 --- a/src/lib.rs +++ b/src/lib.rs @@ -70,6 +70,7 @@ pub mod log; use std::os::raw::c_char; pub use error::{Error, Result}; +pub use sexp::environment::EnvironmentSexp; pub use sexp::external_pointer::{ get_external_pointer_addr, take_external_pointer_value, ExternalPointerSexp, IntoExtPtrSexp, }; diff --git a/src/sexp/environment.rs b/src/sexp/environment.rs new file mode 100644 index 00000000..2cfa1417 --- /dev/null +++ b/src/sexp/environment.rs @@ -0,0 +1,108 @@ +use std::ffi::CString; + +use savvy_ffi::{R_GlobalEnv, R_NilValue, R_UnboundValue, Rboolean_FALSE, Rboolean_TRUE, SEXP}; + +use crate::Sexp; + +use super::utils::str_to_symsxp; + +/// An environment. +pub struct EnvironmentSexp(pub SEXP); + +impl EnvironmentSexp { + /// Returns the raw SEXP. + #[inline] + pub fn inner(&self) -> savvy_ffi::SEXP { + self.0 + } + + /// Returns the SEXP bound to a variable of the specified name in the + /// specified environment. + /// + /// The absense of an object with the specified name is represented as + /// `None`. `Some(NilSexp)` means there's a variable whose value is `NULL`. + /// + /// # Protection + /// + /// The result `Sexp` is unprotected. In most of the cases, you don't need + /// to worry about this because existing in an environment means it won't be + /// GC-ed as long as the environment exists (it's possible the correspondig + /// variable gets explicitly removed, but it should be rare). However, if + /// the environment is a temporary one (e.g. an exectuion environment of a + /// function call), it's your responsibility to protect the object. In other + /// words, you should never use this if you don't understand how R's + /// protection mechanism works. + pub fn get>(&self, name: T) -> crate::error::Result> { + let sym = str_to_symsxp(name)?.ok_or("name must not be empty")?; + + // Note: since this SEXP already belongs to an environment, this doesn't + // need protection. + let sexp = unsafe { + crate::unwind_protect(|| savvy_ffi::Rf_findVarInFrame3(self.0, sym, Rboolean_TRUE))? + }; + + if sexp == unsafe { R_UnboundValue } { + Ok(None) + } else { + Ok(Some(Sexp(sexp))) + } + } + + /// Returns `true` the specified environment contains the specified + /// variable. + pub fn contains>(&self, name: T) -> crate::error::Result { + let sym = str_to_symsxp(name)?.ok_or("name must not be empty")?; + + let res = unsafe { + crate::unwind_protect(|| savvy_ffi::Rf_findVarInFrame3(self.0, sym, Rboolean_FALSE))? + != R_UnboundValue + }; + + Ok(res) + } + + /// Bind the SEXP to the specified environment as the specified name. + pub fn set>(&self, name: T, value: Sexp) -> crate::error::Result<()> { + let name_cstr = match CString::new(name.as_ref()) { + Ok(cstr) => cstr, + Err(e) => return Err(crate::error::Error::new(&e.to_string())), + }; + + unsafe { + crate::unwind_protect(|| { + savvy_ffi::Rf_defineVar(savvy_ffi::Rf_install(name_cstr.as_ptr()), value.0, self.0); + R_NilValue + })? + }; + + Ok(()) + } + + /// Return the global env. + pub fn global_env() -> Self { + Self(unsafe { R_GlobalEnv }) + } +} + +// conversions from/to EnvironmentSexp *************** + +impl TryFrom for EnvironmentSexp { + type Error = crate::error::Error; + + fn try_from(value: Sexp) -> crate::error::Result { + value.assert_environment()?; + Ok(Self(value.0)) + } +} + +impl From for Sexp { + fn from(value: EnvironmentSexp) -> Self { + Self(value.inner()) + } +} + +impl From for crate::error::Result { + fn from(value: EnvironmentSexp) -> Self { + Ok(::from(value)) + } +} diff --git a/src/sexp/function.rs b/src/sexp/function.rs index 2caaf68d..10e5c27d 100644 --- a/src/sexp/function.rs +++ b/src/sexp/function.rs @@ -1,15 +1,11 @@ -use std::ffi::CString; - -use savvy_ffi::{ - R_NilValue, Rf_cons, Rf_eval, Rf_install, Rf_lcons, CDR, SETCAR, SETCDR, SET_TAG, SEXP, -}; +use savvy_ffi::{R_NilValue, Rf_cons, Rf_eval, Rf_lcons, CDR, SETCAR, SETCDR, SET_TAG, SEXP}; use crate::{ protect::{self, local_protect}, unwind_protect, EvalResult, ListSexp, }; -use super::Sexp; +use super::{utils::str_to_symsxp, Sexp}; /// An external SEXP of a function. pub struct FunctionSexp(pub SEXP); @@ -23,10 +19,13 @@ pub struct FunctionArgs { } impl FunctionArgs { + /// Returns the raw SEXP. + #[inline] pub fn inner(&self) -> SEXP { self.head } + /// Returns the length of the SEXP. pub fn len(&self) -> usize { self.len } @@ -76,14 +75,9 @@ impl FunctionArgs { } // Set the arg name - let arg_name = arg_name.as_ref(); - if !arg_name.is_empty() { - let arg_name_cstr = match CString::new(arg_name) { - Ok(cstr) => cstr, - Err(e) => return Err(crate::error::Error::new(&e.to_string())), - }; + if let Some(sym) = str_to_symsxp(arg_name)? { unsafe { - SET_TAG(self.tail, Rf_install(arg_name_cstr.as_ptr())); + SET_TAG(self.tail, sym); } } @@ -109,12 +103,20 @@ impl Drop for FunctionArgs { } impl FunctionSexp { + /// Returns the raw SEXP. #[inline] pub fn inner(&self) -> savvy_ffi::SEXP { self.0 } - /// Execute an R function + /// Execute an R function and get the result. + /// + /// # Protection + /// + /// The result is protected as long as it's wrapped in `EvalResult`. If you + /// extract the raw result from it, it's your responsibility to protect it + /// properly. In other words, you should never do it if you don't understand + /// how R's protection mechanism works. pub fn call(&self, args: FunctionArgs) -> crate::error::Result { unsafe { let call = if args.is_empty() { diff --git a/src/sexp/mod.rs b/src/sexp/mod.rs index aeeb66a6..aab7792f 100644 --- a/src/sexp/mod.rs +++ b/src/sexp/mod.rs @@ -1,18 +1,21 @@ use std::ffi::{CStr, CString}; use savvy_ffi::{ - R_NilValue, Rf_getAttrib, Rf_isFunction, Rf_isInteger, Rf_isLogical, Rf_isNumeric, Rf_isReal, - Rf_isString, Rf_type2char, Rf_xlength, EXTPTRSXP, INTEGER, SEXP, SEXPTYPE, TYPEOF, VECSXP, + R_NilValue, Rf_getAttrib, Rf_isEnvironment, Rf_isFunction, Rf_isInteger, Rf_isLogical, + Rf_isNumeric, Rf_isReal, Rf_isString, Rf_type2char, Rf_xlength, EXTPTRSXP, INTEGER, SEXP, + SEXPTYPE, TYPEOF, VECSXP, }; use crate::{ - ExternalPointerSexp, IntegerSexp, ListSexp, LogicalSexp, NullSexp, OwnedIntegerSexp, - OwnedLogicalSexp, OwnedRealSexp, OwnedStringSexp, RealSexp, StringSexp, + EnvironmentSexp, ExternalPointerSexp, FunctionSexp, IntegerSexp, ListSexp, LogicalSexp, + NullSexp, OwnedIntegerSexp, OwnedLogicalSexp, OwnedRealSexp, OwnedStringSexp, RealSexp, + StringSexp, }; #[cfg(feature = "complex")] use crate::{ComplexSexp, OwnedComplexSexp}; +pub mod environment; pub mod external_pointer; pub mod function; pub mod integer; @@ -91,6 +94,10 @@ impl Sexp { unsafe { Rf_isFunction(self.0) == 1 } } + pub fn is_environment(&self) -> bool { + unsafe { Rf_isEnvironment(self.0) == 1 } + } + fn is_sexp_type(&self, sexptype: SEXPTYPE) -> bool { match sexptype { savvy_ffi::INTSXP => self.is_integer(), @@ -103,6 +110,7 @@ impl Sexp { savvy_ffi::EXTPTRSXP => self.is_external_pointer(), // cf. https://github.com/wch/r-source/blob/95ac44a87065d5b42579b621d278adc44641dcf0/src/include/Rinlinedfuns.h#L810-L815 savvy_ffi::CLOSXP | savvy_ffi::BUILTINSXP | savvy_ffi::SPECIALSXP => self.is_function(), + savvy_ffi::ENVSXP => self.is_environment(), savvy_ffi::NILSXP => self.is_null(), _ => false, } @@ -182,6 +190,11 @@ impl Sexp { pub fn assert_function(&self) -> crate::error::Result<()> { impl_sexp_type_assert!(self, CLOSXP) } + + /// Returns error when the SEXP is not a function. + pub fn assert_environment(&self) -> crate::error::Result<()> { + impl_sexp_type_assert!(self, ENVSXP) + } } #[non_exhaustive] @@ -197,6 +210,7 @@ pub enum TypedSexp { Null(NullSexp), ExternalPointer(ExternalPointerSexp), Function(FunctionSexp), + Environment(EnvironmentSexp), Other(SEXP), } @@ -219,6 +233,7 @@ into_typed_sxp!(StringSexp, String); into_typed_sxp!(ListSexp, List); into_typed_sxp!(ExternalPointerSexp, ExternalPointer); into_typed_sxp!(FunctionSexp, Function); +into_typed_sxp!(EnvironmentSexp, Environment); into_typed_sxp!(NullSexp, Null); macro_rules! into_typed_sxp_owned { @@ -251,6 +266,7 @@ impl From for SEXP { TypedSexp::List(sxp) => sxp.inner(), TypedSexp::ExternalPointer(sxp) => sxp.inner(), TypedSexp::Function(sxp) => sxp.inner(), + TypedSexp::Environment(sxp) => sxp.inner(), TypedSexp::Other(sxp) => sxp, } } @@ -273,6 +289,7 @@ impl Sexp { savvy_ffi::CLOSXP | savvy_ffi::BUILTINSXP | savvy_ffi::SPECIALSXP => { TypedSexp::Function(FunctionSexp(self.0)) } + savvy_ffi::ENVSXP => TypedSexp::Environment(EnvironmentSexp(self.0)), savvy_ffi::NILSXP => TypedSexp::Null(NullSexp), _ => TypedSexp::Other(self.0), } @@ -555,5 +572,3 @@ macro_rules! impl_common_sexp_ops_owned { pub(crate) use impl_common_sexp_ops; pub(crate) use impl_common_sexp_ops_owned; - -use self::function::FunctionSexp; diff --git a/src/sexp/utils.rs b/src/sexp/utils.rs index 4c1c445a..53a400f6 100644 --- a/src/sexp/utils.rs +++ b/src/sexp/utils.rs @@ -1,4 +1,7 @@ -use std::{ffi::CStr, os::raw::c_char}; +use std::{ + ffi::{CStr, CString}, + os::raw::c_char, +}; use savvy_ffi::{cetype_t_CE_UTF8, Rf_mkCharLenCE, Rf_xlength, R_CHAR, SEXP}; @@ -48,3 +51,19 @@ pub(crate) unsafe fn charsxp_to_str(v: SEXP) -> &'static str { .unwrap_or_default() } } + +// Note: the result is not protected (although symbol is probably not GC-ed?) +pub(crate) fn str_to_symsxp>(name: T) -> crate::error::Result> { + let name = name.as_ref(); + if name.is_empty() { + return Ok(None); + } + + let name_cstr = match CString::new(name) { + Ok(cstr) => cstr, + Err(e) => return Err(crate::error::Error::new(&e.to_string())), + }; + let sym = unsafe { crate::unwind_protect(|| savvy_ffi::Rf_install(name_cstr.as_ptr())) }?; + + Ok(Some(sym)) +} diff --git a/xtask/src/main.rs b/xtask/src/main.rs index a080dbf4..2fd4d7e1 100644 --- a/xtask/src/main.rs +++ b/xtask/src/main.rs @@ -154,6 +154,9 @@ fn show() -> Result<(), DynError> { .allowlist_function("Rf_isEnvironment") .allowlist_function("Rf_eval") .allowlist_var("R_GlobalEnv") + .allowlist_function("Rf_findVarInFrame3") + .allowlist_function("Rf_defineVar") + .allowlist_var("R_UnboundValue") // parse .allowlist_item("ParseStatus") .allowlist_function("R_ParseVector")