rustr/
eval.rs

1//! Evaluate R script
2//!
3
4use error::{rraise, rerror, SEXPResult};
5use ::error::REKind::*;
6use ::rdll::*;
7use ::protect::stackp::*;
8
9use util::*;
10use std::result::Result::Ok;
11use ::traits::*;
12
13
14// SEXP Rcpp_eval(SEXP expr_, SEXP env = R_GlobalEnv);
15
16#[inline]
17pub fn rustr_eval(expr: SEXP, env: SEXP) -> SEXPResult {
18
19    // define the evalq call -- the actual R evaluation we
20    // want to execute
21    unsafe {
22        // 'identity' function used to capture errors, interrupts
23        let identity = Rf_findFun(cstr_sym("identity"), R_BaseNamespace);
24
25        if identity == R_UnboundValue {
26            return rraise::<SEXP, _>("Failed to find 'base::identity()'");
27        }
28
29
30        let evalq_call = Shield::new(Rf_lang3(Rf_install(c_str("evalq").as_ptr()), expr, env));
31
32        // define the call -- enclose with `tryCatch` so we can record
33        // and later forward error messages
34        let call = Shield::new(Rf_lang4(cstr_sym("tryCatch"), evalq_call.s(), identity, identity));
35
36        SET_TAG(CDDR(call.s()), Rf_install(c_str("error").as_ptr()));
37        SET_TAG(CDDR(CDR(call.s())), Rf_install(c_str("interrupt").as_ptr()));
38
39        // execute the call
40        let res = Shield::new(Rf_eval(call.s(), R_GlobalEnv));
41
42        // check for condition results (errors, interrupts)
43        if Rf_inherits(res.s(), c_str("condition").as_ptr()) == Rboolean::TRUE {
44
45            if Rf_inherits(res.s(), c_str("error").as_ptr()) == Rboolean::TRUE {
46
47                let condition_message_call = Shield::new(Rf_lang2(Rf_install(c_str("conditionM\
48                                                                                    essage")
49                                                                                 .as_ptr()),
50                                                                  res.s()));
51
52                let condition_message = Shield::new(Rf_eval(condition_message_call.s(),
53                                                            R_GlobalEnv));
54
55                // throw eval_error(CHAR(STRING_ELT(conditionMessage, 0)));
56                let ss = Vec::<String>::rnew(condition_message.s())?;
57                return rerror(EvalError(ss[0].clone().into()));
58
59            }
60
61            if Rf_inherits(res.s(), c_str("interrupt").as_ptr()) == Rboolean::TRUE {
62                return rerror(Interrupted("in rustr_eval".into()));
63            }
64        }
65
66        Ok(res.s())
67    }
68
69
70}