Merge pull request #254 from posit-dev/feature/r-call

lionel- · web-flow · commit e5b1a4afdebe · 2024-02-29T10:34:08.000+01:00
Extract `RCall` from `RFunction`
diff --git a/crates/ark/src/variables/variable.rs b/crates/ark/src/variables/variable.rs
@@ -8,7 +8,6 @@
 use amalthea::comm::variables_comm::ClipboardFormatFormat;
 use amalthea::comm::variables_comm::Variable;
 use amalthea::comm::variables_comm::VariableKind;
-use harp::call::RCall;
 use harp::environment::Binding;
 use harp::environment::BindingValue;
 use harp::environment::Environment;
@@ -497,8 +496,7 @@ impl PositronVariable {
                         Ok(RSymbol::new_unchecked(code).to_string())
                     },
                     LANGSXP => {
-                        let code = RCall::new(code)?;
-                        let fun = RSymbol::new(CAR(*code))?;
+                        let fun = RSymbol::new(CAR(code))?;
                         if fun == "lazyLoadDBfetch" {
                             return Ok(String::from("(unevaluated)"))
                         }
diff --git a/crates/ark/tests/help.rs b/crates/ark/tests/help.rs
@@ -82,8 +82,12 @@ fn test_help_comm() {
         assert_eq!(handled, false);
 
         // Figure out which port the R help server is running on (or would run on)
-        let r_help_port =
-            r_task(|| unsafe { RFunction::new("tools", "httpdPort").call()?.to::<u16>() }).unwrap();
+        let r_help_port = r_task(|| unsafe {
+            RFunction::new_internal("tools", "httpdPort")
+                .call()?
+                .to::<u16>()
+        })
+        .unwrap();
 
         // Send a request to show a help URL with a valid help URL. This one should
         // be handled.
diff --git a/crates/harp/src/call.rs b/crates/harp/src/call.rs
@@ -5,42 +5,77 @@
 //
 //
 
-use std::ops::Deref;
+use libr::*;
 
-use libr::LANGSXP;
-use libr::SEXP;
-
-use crate::error::Result;
+use crate::exec::RFunction;
+use crate::exec::RFunctionExt;
 use crate::object::RObject;
-use crate::utils::r_assert_type;
+use crate::r_symbol;
+use crate::utils::r_typeof;
 
 pub struct RCall {
-    pub object: RObject,
+    function: RObject,
+    arguments: Vec<RArgument>,
 }
 
 impl RCall {
-    pub fn new_unchecked(object: impl Into<RObject>) -> Self {
+    pub fn new(function: impl Into<RObject>) -> Self {
         Self {
-            object: object.into(),
+            function: function.into(),
+            arguments: Vec::new(),
         }
     }
 
-    pub fn new(object: impl Into<RObject>) -> Result<Self> {
-        let object = object.into();
-        r_assert_type(*object, &[LANGSXP])?;
-        Ok(Self::new_unchecked(object))
+    pub fn param(&mut self, name: &str, value: impl Into<RObject>) -> &mut Self {
+        self.arguments.push(RArgument {
+            name: name.to_string(),
+            value: value.into(),
+        });
+        self
+    }
+
+    pub fn add(&mut self, value: impl Into<RObject>) -> &mut Self {
+        self.param("", value)
+    }
+
+    pub fn build(&self) -> RObject {
+        unsafe {
+            let call = RObject::new(Rf_lcons(self.function.sexp, R_NilValue));
+            let mut tail = call.sexp;
+
+            // Append arguments to the call
+            for argument in self.arguments.iter() {
+                SETCDR(tail, Rf_cons(argument.value.sexp, R_NilValue));
+
+                tail = CDR(tail);
+                if !argument.name.is_empty() {
+                    SET_TAG(tail, r_symbol!(argument.name));
+                }
+            }
+
+            call
+        }
     }
 }
 
-impl Deref for RCall {
-    type Target = SEXP;
-    fn deref(&self) -> &Self::Target {
-        &self.object
+pub fn r_expr_quote(x: impl Into<SEXP>) -> RObject {
+    let x = x.into();
+    match r_typeof(x) {
+        SYMSXP | LANGSXP => return RFunction::new("base", "quote").add(x).call.build(),
+        _ => return x.into(),
     }
 }
 
-impl From<RCall> for RObject {
-    fn from(value: RCall) -> Self {
-        value.object
+pub struct RArgument {
+    pub name: String,
+    pub value: RObject,
+}
+
+impl RArgument {
+    pub fn new(name: &str, value: RObject) -> Self {
+        Self {
+            name: name.to_string(),
+            value,
+        }
     }
 }
diff --git a/crates/harp/src/exec.rs b/crates/harp/src/exec.rs
@@ -12,6 +12,7 @@ use std::os::raw::c_void;
 
 use libr::*;
 
+use crate::call::RCall;
 use crate::environment::R_ENVS;
 use crate::error::Error;
 use crate::error::Result;
@@ -25,126 +26,67 @@ use crate::r_string;
 use crate::r_symbol;
 use crate::utils::r_inherits;
 use crate::utils::r_stringify;
-use crate::utils::r_typeof;
 use crate::vector::CharacterVector;
 use crate::vector::Vector;
-pub struct RArgument {
-    pub name: String,
-    pub value: RObject,
-}
-
-impl RArgument {
-    pub fn new(name: &str, value: RObject) -> Self {
-        Self {
-            name: name.to_string(),
-            value,
-        }
-    }
-}
 
 pub struct RFunction {
-    package: String,
-    function: String,
-    arguments: Vec<RArgument>,
+    pub call: RCall,
+    is_namespaced: bool,
 }
 
-pub trait RFunctionExt<T> {
-    fn param(&mut self, name: &str, value: T) -> &mut Self;
-    fn add(&mut self, value: T) -> &mut Self;
-}
+impl RFunction {
+    pub fn new(package: &str, function: &str) -> Self {
+        Self::new_ext(package, function, false)
+    }
 
-impl<T: Into<RObject>> RFunctionExt<Option<T>> for RFunction {
-    fn param(&mut self, name: &str, value: Option<T>) -> &mut Self {
-        if let Some(value) = value {
-            self._add(name, value.into());
-        }
-        self
+    pub fn new_internal(package: &str, function: &str) -> Self {
+        Self::new_ext(package, function, true)
     }
 
-    fn add(&mut self, value: Option<T>) -> &mut Self {
-        if let Some(value) = value {
-            self._add("", value.into());
+    pub fn new_inlined(function: impl Into<RObject>) -> Self {
+        RFunction {
+            call: RCall::new(function),
+            is_namespaced: false,
         }
-        self
     }
-}
 
-impl<T: Into<RObject>> RFunctionExt<T> for RFunction {
-    fn param(&mut self, name: &str, value: T) -> &mut Self {
-        let value: RObject = value.into();
-        return self._add(name, value);
-    }
+    fn new_ext(package: &str, function: &str, internal: bool) -> Self {
+        unsafe {
+            let is_namespaced = !package.is_empty();
 
-    fn add(&mut self, value: T) -> &mut Self {
-        let value: RObject = value.into();
-        return self._add("", value);
-    }
-}
+            let fun = if is_namespaced {
+                let op = if internal { ":::" } else { "::" };
+                Rf_lang3(r_symbol!(op), r_symbol!(package), r_symbol!(function))
+            } else {
+                r_symbol!(function)
+            };
+            let fun = RObject::new(fun);
 
-impl RFunction {
-    pub fn new(package: &str, function: &str) -> Self {
-        RFunction {
-            package: package.to_string(),
-            function: function.to_string(),
-            arguments: Vec::new(),
+            RFunction {
+                call: RCall::new(fun),
+                is_namespaced,
+            }
         }
     }
 
-    fn _add(&mut self, name: &str, value: RObject) -> &mut Self {
-        self.arguments.push(RArgument {
-            name: name.to_string(),
-            value,
-        });
-        self
-    }
-
     pub fn call(&mut self) -> Result<RObject> {
-        let env = if self.package.is_empty() {
-            R_ENVS.global
-        } else {
+        // FIXME: Once we have ArkFunction (see
+        // https://github.com/posit-dev/positron/issues/2324), we no longer need
+        // this logic to call in global. This probably shouldn't be the default?
+        let env = if self.is_namespaced {
             R_ENVS.base
+        } else {
+            R_ENVS.global
         };
 
         self.call_in(env)
     }
 
     pub fn call_in(&mut self, env: SEXP) -> Result<RObject> {
         unsafe {
-            let mut protect = RProtect::new();
-
-            // start building the call to be evaluated
-            let mut lhs = r_symbol!(self.function);
-            if !self.package.is_empty() {
-                lhs = protect.add(Rf_lang3(r_symbol!(":::"), r_symbol!(self.package), lhs));
-            }
-
-            // now, build the actual call to be evaluated
-            let size = (1 + self.arguments.len()) as R_xlen_t;
-            let call = protect.add(Rf_allocVector(LANGSXP, size));
-            SET_TAG(call, R_NilValue);
-            SETCAR(call, lhs);
-
-            // append arguments to the call
-            let mut slot = CDR(call);
-            for argument in self.arguments.iter() {
-                // quote language objects by default
-                let mut sexp = argument.value.sexp;
-                if matches!(r_typeof(sexp), LANGSXP | SYMSXP | EXPRSXP) {
-                    let quote = protect.add(Rf_lang3(
-                        r_symbol!("::"),
-                        r_symbol!("base"),
-                        r_symbol!("quote"),
-                    ));
-                    sexp = protect.add(Rf_lang2(quote, sexp));
-                }
+            let call = self.call.build();
 
-                SETCAR(slot, sexp);
-                if !argument.name.is_empty() {
-                    SET_TAG(slot, r_symbol!(argument.name));
-                }
-
-                slot = CDR(slot);
-            }
+            let mut protect = RProtect::new();
 
             // now, wrap call in tryCatch, so that errors don't longjmp
             let try_catch = protect.add(Rf_lang3(
@@ -154,7 +96,7 @@ impl RFunction {
             ));
             let call = protect.add(Rf_lang4(
                 try_catch,
-                call,
+                call.sexp,
                 r_symbol!("identity"),
                 r_symbol!("identity"),
             ));
@@ -187,6 +129,41 @@ impl From<String> for RFunction {
     }
 }
 
+// NOTE: Having to import this trait cause a bit of friction during
+// development. Can we do without?
+pub trait RFunctionExt<T> {
+    fn param(&mut self, name: &str, value: T) -> &mut Self;
+    fn add(&mut self, value: T) -> &mut Self;
+}
+
+impl<T: Into<RObject>> RFunctionExt<Option<T>> for RFunction {
+    fn param(&mut self, name: &str, value: Option<T>) -> &mut Self {
+        if let Some(value) = value {
+            self.call.param(name, value.into());
+        }
+        self
+    }
+
+    fn add(&mut self, value: Option<T>) -> &mut Self {
+        if let Some(value) = value {
+            self.call.add(value.into());
+        }
+        self
+    }
+}
+
+impl<T: Into<RObject>> RFunctionExt<T> for RFunction {
+    fn param(&mut self, name: &str, value: T) -> &mut Self {
+        self.call.param(name, value);
+        self
+    }
+
+    fn add(&mut self, value: T) -> &mut Self {
+        self.call.add(value);
+        self
+    }
+}
+
 pub fn geterrmessage() -> String {
     // SAFETY: Returns pointer to static memory buffer owned by R.
     let buffer = unsafe { R_curErrorBuf() };
@@ -495,6 +472,9 @@ pub fn r_source_exprs_in(exprs: impl Into<SEXP>, env: impl Into<SEXP>) -> crate:
     let exprs = exprs.into();
     let env = env.into();
 
+    // `exprs` is an EXPRSXP and doesn't need to be quoted when passed as
+    // literal argument. Only the R-level `eval()` function evaluates expression
+    // vectors.
     RFunction::new("base", "source")
         .param("exprs", exprs)
         .param("local", env)
@@ -681,6 +661,7 @@ mod tests {
     use crate::r_test;
     use crate::utils::r_envir_remove;
     use crate::utils::r_is_null;
+    use crate::utils::r_typeof;
 
     #[test]
     fn test_basic_function() {
diff --git a/crates/harp/src/utils.rs b/crates/harp/src/utils.rs
@@ -14,13 +14,14 @@ use libr::*;
 use once_cell::sync::Lazy;
 use regex::Regex;
 
+use crate::call::r_expr_quote;
+use crate::call::RArgument;
 use crate::environment::Environment;
 use crate::environment::R_ENVS;
 use crate::error::Error;
 use crate::error::Result;
 use crate::eval::r_parse_eval0;
 use crate::exec::geterrmessage;
-use crate::exec::RArgument;
 use crate::exec::RFunction;
 use crate::exec::RFunctionExt;
 use crate::object::RObject;
@@ -401,7 +402,9 @@ pub unsafe fn r_stringify(object: SEXP, delimiter: &str) -> Result<String> {
     }
 
     // call format on the object
-    let object = RFunction::new("base", "format").add(object).call()?;
+    let object = RFunction::new("base", "format")
+        .add(r_expr_quote(object))
+        .call()?;
 
     // paste into a single string
     let object = RFunction::new("base", "paste")
