Record backtraces in RFunction calls

Author: lionel-

crates/harp/src/exec.rs

@@ -19,12 +19,14 @@ use crate::error::Result;
 use crate::interrupts::RInterruptsSuspendedScope;
 use crate::line_ending::convert_line_endings;
 use crate::line_ending::LineEnding;
+use crate::modules::HARP_ENV;
+use crate::object::r_list_get;
 use crate::object::RObject;
 use crate::polled_events::RPolledEventsSuspendedScope;
 use crate::protect::RProtect;
+use crate::r_null;
 use crate::r_string;
 use crate::r_symbol;
-use crate::utils::r_inherits;
 use crate::utils::r_stringify;
 use crate::vector::CharacterVector;
 use crate::vector::Vector;
@@ -84,35 +86,36 @@ impl RFunction {
 
     pub fn call_in(&mut self, env: SEXP) -> Result<RObject> {
         unsafe {
-            let call = self.call.build();
+            let user_call = self.call.build();
+            let eval_call = RCall::new(r_symbol!("safe_evalq"))
+                .add(user_call.sexp)
+                .add(env)
+                .build();
 
-            let mut protect = RProtect::new();
+            let result = RObject::new(Rf_eval(eval_call.sexp, HARP_ENV.unwrap()));
+
+            // Invariant of return value: List of length 2 [output, error].
+            // These are exclusive.
+            let out = r_list_get(result.sexp, 0);
+            let err = r_list_get(result.sexp, 1);
+
+            if err != r_null() {
+                let code = r_stringify(user_call.sexp, "\n")?;
 
-            // now, wrap call in tryCatch, so that errors don't longjmp
-            let try_catch = protect.add(Rf_lang3(
-                r_symbol!("::"),
-                r_symbol!("base"),
-                r_symbol!("tryCatch"),
-            ));
-            let call = protect.add(Rf_lang4(
-                try_catch,
-                call.sexp,
-                r_symbol!("identity"),
-                r_symbol!("identity"),
-            ));
-            SET_TAG(call, R_NilValue);
-            SET_TAG(CDDR(call), r_symbol!("error"));
-            SET_TAG(CDDDR(call), r_symbol!("interrupt"));
-
-            let result = protect.add(Rf_eval(call, env));
-
-            if r_inherits(result, "error") {
-                let code = r_stringify(call, "\n")?;
-                let message = geterrmessage();
-                return Err(Error::EvaluationError { code, message });
+                // Invariant of error slot: Character vector of length 2 [message, trace],
+                // with `trace` possibly an empty string.
+                let err = CharacterVector::new(err)?;
+
+                let message = err.get_value(0)?;
+                let trace = err.get_value(1)?;
+
+                return Err(Error::EvaluationError {
+                    code,
+                    message: message + "\nTrace:\n" + &trace,
+                });
             }
 
-            return Ok(RObject::new(result));
+            return Ok(RObject::new(out));
         }
     }
 }
@@ -681,6 +684,22 @@ mod tests {
         }
     }
 
+    #[test]
+    fn test_basic_function_error() {
+        r_test! {
+            let result = RFunction::from("+")
+                .add(1)
+                .add("")
+                .call();
+
+            assert_match!(result, Err(err) => {
+                let msg = format!("{err}");
+                let re = regex::Regex::new("Trace:\n(.|\n)*1L [+] \"\"").unwrap();
+                assert!(re.is_match(&msg));
+            });
+        }
+    }
+
     #[test]
     fn test_utf8_strings() {
         r_test! {

crates/harp/src/lib.rs

@@ -62,6 +62,10 @@ pub type Result<T> = std::result::Result<T, error::Error>;
 // doesn't need synchronisation.
 pub static mut R_MAIN_THREAD_ID: Option<std::thread::ThreadId> = None;
 
+pub fn r_null() -> libr::SEXP {
+    unsafe { libr::R_NilValue }
+}
+
 #[macro_export]
 macro_rules! with_vector_impl {
     ($x:expr, $class:ident, $variable:ident, $($code:tt)*) => {{

crates/harp/src/modules.rs

@@ -1,12 +1,15 @@
 use anyhow::anyhow;
 use libr::R_PreserveObject;
+use libr::Rf_eval;
 use libr::SEXP;
 use rust_embed::RustEmbed;
 
+use crate::call::RCall;
 use crate::environment::R_ENVS;
+use crate::exec::r_parse_exprs;
 use crate::exec::r_source_str_in;
-use crate::exec::RFunction;
-use crate::exec::RFunctionExt;
+use crate::exec::r_top_level_exec;
+use crate::r_symbol;
 
 pub static mut HARP_ENV: Option<SEXP> = None;
 
@@ -27,19 +30,32 @@ where
 }
 
 pub fn init_modules() -> anyhow::Result<()> {
-    let namespace = RFunction::new("base", "new.env")
-        .param("parent", R_ENVS.base)
-        .call()?;
+    let namespace = unsafe {
+        let new_env_call = RCall::new(r_symbol!("new.env")).build();
+        Rf_eval(new_env_call.sexp, R_ENVS.base)
+    };
 
     unsafe {
-        R_PreserveObject(namespace.sexp);
-        HARP_ENV = Some(namespace.sexp);
+        R_PreserveObject(namespace);
+        HARP_ENV = Some(namespace);
     }
 
+    // We don't have `safe_eval()` yet so source the init file manually
+    with_asset::<HarpModuleAsset, _>("init.R", |source| {
+        let exprs = r_parse_exprs(source)?;
+        unsafe {
+            let source_call = RCall::new(r_symbol!("source"))
+                .param("exprs", exprs)
+                .param("local", namespace)
+                .build();
+            r_top_level_exec(|| Rf_eval(source_call.sexp, R_ENVS.base))?;
+        }
+        Ok(())
+    })?;
+
+    // It's alright to source the init file twice
     for file in HarpModuleAsset::iter() {
-        with_asset::<HarpModuleAsset, _>(&file, |source| {
-            Ok(r_source_str_in(source, namespace.sexp)?)
-        })?;
+        with_asset::<HarpModuleAsset, _>(&file, |source| Ok(r_source_str_in(source, namespace)?))?;
     }
 
     Ok(())

crates/harp/src/modules/init.R

@@ -0,0 +1,36 @@
+# Invariants:
+#
+# - Return value: List of length 2 [output, error]. These are exclusive.
+#
+# - Error slot: Character vector of length 2 [message, trace], with `trace`
+#   possibly an empty string.
+#
+# TODO: Prevent this function from jumping with on.exit
+safe_evalq <- function(expr, env) {
+    # Create a promise to make call stack leaner
+    do.call(delayedAssign, list("out", substitute(expr), env))
+
+    # Prepare non-local exit with error value
+    err <- NULL
+    delayedAssign("bail", return(list(NULL, err)))
+
+    handler <- function(cnd) {
+        # Save backtrace in error value
+        calls <- sys.calls()
+        trace <- paste(format(calls), collapse = '\n')
+
+        message <- conditionMessage(cnd)
+
+        # A character vector is easier to destructure from Rust.
+        err <<- c(message, trace)
+
+        # Trigger non-local return
+        force(bail)
+    }
+
+    withCallingHandlers(
+        list(out, NULL),
+        interrupt = handler,
+        error = handler
+    )
+}

crates/harp/src/vector/mod.rs

@@ -65,6 +65,14 @@ pub trait Vector {
         Ok(self.get_unchecked(index))
     }
 
+    // Better name?
+    fn get_value(&self, index: isize) -> Result<Self::Type> {
+        let value = self
+            .get(index)?
+            .ok_or(crate::error::Error::MissingValueError)?;
+        Ok(value)
+    }
+
     unsafe fn new(object: impl Into<SEXP>) -> Result<Self>
     where
         Self: Sized,