Add EnvironmentSexp (#254)

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)
 }

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},

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);

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<EnvironmentSexp>) -> savvy::Result<Sexp> {
+    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<EnvironmentSexp>) -> savvy::Result<Sexp> {
+    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<EnvironmentSexp>) -> savvy::Result<()> {
+    let env = env.unwrap_or(EnvironmentSexp::global_env());
+    env.set(name, value)
+}

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;

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")
+})

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,

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

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,
 };

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<T: AsRef<str>>(&self, name: T) -> crate::error::Result<Option<crate::Sexp>> {
+        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<T: AsRef<str>>(&self, name: T) -> crate::error::Result<bool> {
+        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<T: AsRef<str>>(&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<Sexp> for EnvironmentSexp {
+    type Error = crate::error::Error;
+
+    fn try_from(value: Sexp) -> crate::error::Result<Self> {
+        value.assert_environment()?;
+        Ok(Self(value.0))
+    }
+}
+
+impl From<EnvironmentSexp> for Sexp {
+    fn from(value: EnvironmentSexp) -> Self {
+        Self(value.inner())
+    }
+}
+
+impl From<EnvironmentSexp> for crate::error::Result<Sexp> {
+    fn from(value: EnvironmentSexp) -> Self {
+        Ok(<Sexp>::from(value))
+    }
+}

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<EvalResult> {
         unsafe {
             let call = if args.is_empty() {