Rcpp Version 0.12.12
Rcpp_eval.h
Go to the documentation of this file.
1 // Copyright (C) 2013 Romain Francois
2 //
3 // This file is part of Rcpp.
4 //
5 // Rcpp is free software: you can redistribute it and/or modify it
6 // under the terms of the GNU General Public License as published by
7 // the Free Software Foundation, either version 2 of the License, or
8 // (at your option) any later version.
9 //
10 // Rcpp is distributed in the hope that it will be useful, but
11 // WITHOUT ANY WARRANTY; without even the implied warranty of
12 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 // GNU General Public License for more details.
14 //
15 // You should have received a copy of the GNU General Public License
16 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
17 
18 #ifndef Rcpp_api_meat_Rcpp_eval_h
19 #define Rcpp_api_meat_Rcpp_eval_h
20 
21 #include <Rcpp/Interrupt.h>
22 
23 namespace Rcpp {
24 
25 inline SEXP Rcpp_eval(SEXP expr, SEXP env) {
26 
27  // 'identity' function used to capture errors, interrupts
28  SEXP identity = Rf_findFun(::Rf_install("identity"), R_BaseNamespace);
29 
30  if (identity == R_UnboundValue) {
31  stop("Failed to find 'base::identity()'");
32  }
33 
34  // define the evalq call -- the actual R evaluation we want to execute
35  Shield<SEXP> evalqCall(Rf_lang3(::Rf_install("evalq"), expr, env));
36 
37  // define the call -- enclose with `tryCatch` so we can record and forward error messages
38  Shield<SEXP> call(Rf_lang4(::Rf_install("tryCatch"), evalqCall, identity, identity));
39  SET_TAG(CDDR(call), ::Rf_install("error"));
40  SET_TAG(CDDR(CDR(call)), ::Rf_install("interrupt"));
41 
42  // execute the call
43  Shield<SEXP> res(::Rf_eval(call, R_GlobalEnv));
44 
45  // check for condition results (errors, interrupts)
46  if (Rf_inherits(res, "condition")) {
47 
48  if (Rf_inherits(res, "error")) {
49 
50  Shield<SEXP> conditionMessageCall(::Rf_lang2(::Rf_install("conditionMessage"), res));
51 
52  Shield<SEXP> conditionMessage(::Rf_eval(conditionMessageCall, R_GlobalEnv));
53  throw eval_error(CHAR(STRING_ELT(conditionMessage, 0)));
54  }
55 
56  // check for interrupt
57  if (Rf_inherits(res, "interrupt")) {
59  }
60 
61  }
62 
63  return res;
64 }
65 
66 } // namespace Rcpp
67 
68 #endif
SEXP Rcpp_eval(SEXP expr, SEXP env)
Definition: Rcpp_eval.h:25
void NORET stop(const char *fmt, Args &&...args)
Definition: exceptions.h:51
Rcpp API.
Definition: algo.h:28