[Rcpp-commits] r4159 - in pkg/Rcpp: . R src

[noreply at r-forge.r-project.org]

Author: romain
Date: 2012-12-15 23:06:56 +0100 (Sat, 15 Dec 2012)
New Revision: 4159

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/R/exceptions.R
   pkg/Rcpp/src/Rcpp_init.c
   pkg/Rcpp/src/api.cpp
Log:
less going back to R on Evaluator::run

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2012-12-15 20:03:15 UTC (rev 4158)
+++ pkg/Rcpp/ChangeLog	2012-12-15 22:06:56 UTC (rev 4159)
@@ -3,6 +3,9 @@
         * include/Rcpp/exceptions.h: added exception_to_r_condition
         * exceptions.cpp: new implementation of forward_exception_to_r that 
         directly calls stop rather than a function in Rcpp
+        * R/exceptions.R: remove code rendered useless
+        * src/Rcpp_init.c: less exports
+        * src/api.cpp: less going back to the R side
         
 2012-12-14 Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/R/exceptions.R
===================================================================
--- pkg/Rcpp/R/exceptions.R	2012-12-15 20:03:15 UTC (rev 4158)
+++ pkg/Rcpp/R/exceptions.R	2012-12-15 22:06:56 UTC (rev 4159)
@@ -15,43 +15,7 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-cpp_exception <- function( message = "C++ exception", class = NULL, cppstack = rcpp_get_current_stack_trace() ){
-    callstack <- sys.calls()
-    ncalls <- length(callstack)
-    call <- if( ncalls > 1L) callstack[[ ncalls - 1L ]] else match.call()
-    classes <- c( class, "C++Error", "error", "condition" )
-    condition <- structure(list( message = message, call = call, cppstack = cppstack ),
-                           class = classes )
-    setStackTrace( NULL )
-    stop( condition )
-}
-
-## Dummy versions
-rcpp_get_current_stack_trace <- function() "DUMMY STACK TRACE"
-rcpp_set_current_stack_trace <- function(s) NULL
-
-
-# used by Rcpp::Evaluator
-setCurrentError <- function( condition = NULL) .Call( rcpp_set_current_error, condition )
-getCurrentError <- function() .Call( rcpp_get_current_error )
-
-setErrorOccured <- function(error_occured = TRUE) .Call( rcpp_set_error_occured, error_occured )
-getErrorOccured <- function() .Call( rcpp_get_error_occured )
-
-setStackTrace <- function(trace = TRUE) .Call( rcpp_set_stack_trace, trace )
-getStackTrace <- function() .Call( rcpp_get_stack_trace)
-
-# all below are called from Evaluator::run
-# on the C++ side, don't change them unless you also change
-# Evaluator::run
-
-getCurrentErrorMessage <- function() conditionMessage( getCurrentError() )
 .rcpp_error_recorder <- function(e){  
     invisible( .Call( rcpp_error_recorder, e ) )
 }
 
-# for backwards compatibility, but not used anywhere
-rcpp_tryCatch <- function(expr){ 
-    tryCatch(expr, error = .rcpp_error_recorder )
-}
-

Modified: pkg/Rcpp/src/Rcpp_init.c
===================================================================
--- pkg/Rcpp/src/Rcpp_init.c	2012-12-15 20:03:15 UTC (rev 4158)
+++ pkg/Rcpp/src/Rcpp_init.c	2012-12-15 22:06:56 UTC (rev 4159)
@@ -50,15 +50,6 @@
     
     CALLDEF(get_rcpp_cache,0),
     CALLDEF(rcpp_error_recorder,1),
-    CALLDEF(rcpp_set_current_error,1),
-    CALLDEF(rcpp_get_current_error,0),
-    CALLDEF(rcpp_set_error_occured,1), 
-    CALLDEF(rcpp_get_error_occured,0),
-    CALLDEF(rcpp_set_stack_trace,1), 
-    CALLDEF(rcpp_get_stack_trace,0),
-    
-    
-    
     CALLDEF(as_character_externalptr,1),
     
     CALLDEF(CppField__get,3),

Modified: pkg/Rcpp/src/api.cpp
===================================================================
--- pkg/Rcpp/src/api.cpp	2012-12-15 20:03:15 UTC (rev 4158)
+++ pkg/Rcpp/src/api.cpp	2012-12-15 22:06:56 UTC (rev 4159)
@@ -69,20 +69,21 @@
         reset_current_error() ; 
 
         Environment RCPP = Environment::Rcpp_namespace(); 
-        static SEXP tryCatchSym = NULL, evalqSym, getCurrentErrorMessageSym; //, errorOccuredSym;
+        static SEXP tryCatchSym = NULL, evalqSym, conditionMessageSym, errorRecorderSym, errorSym ;
         if (!tryCatchSym) {
             tryCatchSym               = ::Rf_install("tryCatch");
             evalqSym                  = ::Rf_install("evalq");
-            //errorOccuredSym           = ::Rf_install("errorOccured");
-            getCurrentErrorMessageSym = ::Rf_install("getCurrentErrorMessage");
+            conditionMessageSym       = ::Rf_install("conditionMessage");
+            errorRecorderSym          = ::Rf_install(".rcpp_error_recorder");
+            errorSym                  = ::Rf_install("error");
         }
 
         SEXP call = PROTECT( Rf_lang3( 
             tryCatchSym, 
             Rf_lang3( evalqSym, expr, env ),
-            Rf_install( ".rcpp_error_recorder" )
+            errorRecorderSym
         ) ) ;
-        SET_TAG( CDDR(call), Rf_install( "error" ) ) ;
+        SET_TAG( CDDR(call), errorSym ) ;
         /* call the tryCatch call */
         SEXP res  = PROTECT(::Rf_eval( call, RCPP ) );
         
@@ -92,8 +93,11 @@
         UNPROTECT(3) ;
         
         if( error ) {
-            std::string message(CHAR(::Rf_asChar(PROTECT(::Rf_eval(PROTECT(::Rf_lang1(getCurrentErrorMessageSym)), RCPP)))));
-            UNPROTECT( 2 ) ;
+            SEXP current_error        = PROTECT( rcpp_get_current_error() ) ;
+            SEXP conditionMessageCall = PROTECT(::Rf_lang2(conditionMessageSym, current_error)) ;
+            SEXP condition_message    = PROTECT(::Rf_eval(conditionMessageCall, R_GlobalEnv)) ;
+            std::string message(CHAR(::Rf_asChar(condition_message)));
+            UNPROTECT( 3 ) ;
             throw eval_error(message) ;
         }