| 52 | } |
| 53 | |
| 54 | inline SEXP Rcpp_eval(SEXP expr, SEXP env) { |
| 55 | |
| 56 | // 'identity' function used to capture errors, interrupts |
| 57 | Shield<SEXP> identity(Rf_findFun(::Rf_install("identity"), R_BaseNamespace)); |
| 58 | |
| 59 | // define the evalq call -- the actual R evaluation we want to execute |
| 60 | Shield<SEXP> evalqCall(Rf_lang3(::Rf_install("evalq"), expr, env)); |
| 61 | |
| 62 | // define the call -- enclose with `tryCatch` so we can record and forward error messages |
| 63 | Shield<SEXP> call(Rf_lang4(::Rf_install("tryCatch"), evalqCall, identity, identity)); |
| 64 | SET_TAG(CDDR(call), ::Rf_install("error")); |
| 65 | SET_TAG(CDDR(CDR(call)), ::Rf_install("interrupt")); |
| 66 | |
| 67 | Shield<SEXP> res(internal::Rcpp_eval_impl(call, R_BaseEnv)); |
| 68 | |
| 69 | // check for condition results (errors, interrupts) |
| 70 | if (Rf_inherits(res, "condition")) { |
| 71 | |
| 72 | if (Rf_inherits(res, "error")) { |
| 73 | |
| 74 | Shield<SEXP> conditionMessageCall(::Rf_lang2(::Rf_install("conditionMessage"), res)); |
| 75 | |
| 76 | Shield<SEXP> conditionMessage(internal::Rcpp_eval_impl(conditionMessageCall, R_BaseEnv)); |
| 77 | throw eval_error(CHAR(STRING_ELT(conditionMessage, 0))); |
| 78 | } |
| 79 | |
| 80 | // check for interrupt |
| 81 | if (Rf_inherits(res, "interrupt")) { |
| 82 | throw internal::InterruptedException(); |
| 83 | } |
| 84 | |
| 85 | } |
| 86 | |
| 87 | return res; |
| 88 | } |
| 89 | |
| 90 | } // namespace Rcpp |
| 91 | |