[Rcpp-commits] r379 - in pkg: R src

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

Author: romain
Date: 2010-01-15 16:01:18 +0100 (Fri, 15 Jan 2010)
New Revision: 379

Modified:
   pkg/R/exceptions.R
   pkg/src/Evaluator.cpp
Log:
use a simplified version of tryCatch since we only need one handler

Modified: pkg/R/exceptions.R
===================================================================
--- pkg/R/exceptions.R	2010-01-15 14:28:48 UTC (rev 378)
+++ pkg/R/exceptions.R	2010-01-15 15:01:18 UTC (rev 379)
@@ -50,3 +50,24 @@
 	invisible( NULL )
 }
 
+# simplified version of utils::tryCatch
+rcpp_tryCatch <- function(expr,env){
+	resetCurrentError()
+	rcpp_doTryCatch <- function(expr, env) {
+	    .Internal(.addCondHands("error", list(.rcpp_error_recorder), 
+	    	env, environment(), FALSE))
+	    expr
+	}
+	value <- rcpp_doTryCatch( return(expr), env )
+	if (is.null(value[[1L]])) {
+	    # a simple error; message is stored internally
+	    # and call is in result; this defers all allocs until
+	    # after the jump
+	    msg <- .Internal(geterrmessage())
+	    call <- value[[2L]]
+	    cond <- simpleError(msg, call)
+	}
+	else cond <- value[[1L]]
+	.rcpp_error_recorder(cond)
+}
+

Modified: pkg/src/Evaluator.cpp
===================================================================
--- pkg/src/Evaluator.cpp	2010-01-15 14:28:48 UTC (rev 378)
+++ pkg/src/Evaluator.cpp	2010-01-15 15:01:18 UTC (rev 379)
@@ -34,19 +34,10 @@
 	/* grab the RCPP namespace */
 	SEXP RCPP = PROTECT( R_FindNamespace( Rf_mkString( "Rcpp")  ) );
 	
-	/* reset the error cache */
-	Rf_eval( Rf_lang1( Rf_install( "resetCurrentError" ) ), RCPP ) ; 
+	SEXP call = PROTECT( Rf_lang3( Rf_install("rcpp_tryCatch") , expr, env ) ) ;
 	
-	/* grab the error handler from the Rcpp namespace */
-	SEXP handler = PROTECT( Rf_findVarInFrame( RCPP, Rf_install(".rcpp_error_recorder") ) ) ;
-    	
-	/* call to tryCatch, we can probably do better by looking into what tryCatch does */
-	SEXP trycatchcall = PROTECT( Rf_lcons( Rf_install( "tryCatch" ), 
-		Rf_cons( expr,  Rf_cons( handler , R_NilValue ) ) ) ) ;
-	SET_TAG( CDDR(trycatchcall), Rf_install( "error" ) ) ;
-	
 	/* call the tryCatch call */
-	SEXP res = PROTECT( Rf_eval( trycatchcall, R_GlobalEnv ) );
+	SEXP res = PROTECT( Rf_eval( call, RCPP ) );
 	
 	/* was there an error ? */
 	int error = LOGICAL( Rf_eval( Rf_lang1( Rf_install("errorOccured") ), RCPP ) )[0];
@@ -56,10 +47,10 @@
 			Rf_lang1( Rf_install("getCurrentErrorMessage")), 
 			RCPP ) );
 		std::string message = CHAR(STRING_ELT(err_msg,0)) ;
-		UNPROTECT( 5 ) ;
+		UNPROTECT( 4 ) ;
 		throw eval_error(message) ;
 	} else {
-		UNPROTECT(4) ;
+		UNPROTECT(3) ;
 		return res ;
 	}
     }