[Rcpp-commits] r4161 - pkg/Rcpp/src

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

Author: romain
Date: 2012-12-15 23:41:37 +0100 (Sat, 15 Dec 2012)
New Revision: 4161

Modified:
   pkg/Rcpp/src/api.cpp
   pkg/Rcpp/src/barrier.cpp
   pkg/Rcpp/src/internal.h
Log:
cleanups

Modified: pkg/Rcpp/src/api.cpp
===================================================================
--- pkg/Rcpp/src/api.cpp	2012-12-15 22:12:38 UTC (rev 4160)
+++ pkg/Rcpp/src/api.cpp	2012-12-15 22:41:37 UTC (rev 4161)
@@ -87,12 +87,9 @@
         /* call the tryCatch call */
         SEXP res  = PROTECT(::Rf_eval( call, RCPP ) );
         
-        /* was there an error ? */
-        int error = INTEGER( rcpp_get_error_occured())[0] ;
-        
         UNPROTECT(3) ;
         
-        if( error ) {
+        if( error_occured() ) {
             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)) ;

Modified: pkg/Rcpp/src/barrier.cpp
===================================================================
--- pkg/Rcpp/src/barrier.cpp	2012-12-15 22:12:38 UTC (rev 4160)
+++ pkg/Rcpp/src/barrier.cpp	2012-12-15 22:41:37 UTC (rev 4161)
@@ -62,8 +62,6 @@
 #define RCPP_HASH_CACHE_INITIAL_SIZE 1024
 #endif 
 
-SEXP reset_current_error__(SEXP) ;
-
 namespace Rcpp {
     namespace internal {   
 		SEXP get_Rcpp_namespace(){ 
@@ -86,6 +84,25 @@
     return Rcpp_cache ;
 }
 
+SEXP set_error_occured(SEXP cache, SEXP e){
+    SET_VECTOR_ELT( cache, 1, e ) ;
+    return R_NilValue ;
+}
+
+SEXP set_current_error(SEXP cache, SEXP e){ 
+    SET_VECTOR_ELT( cache, 2, e ) ;
+    return R_NilValue ;
+}
+
+SEXP rcpp_set_stack_trace(SEXP e){
+    SET_VECTOR_ELT( get_rcpp_cache(), 3, e ) ;
+    return R_NilValue ;
+}
+
+SEXP rcpp_get_stack_trace(){
+    return VECTOR_ELT( get_rcpp_cache(), 3 ) ;
+}
+
 SEXP init_Rcpp_cache(){   
     SEXP getNamespaceSym = Rf_install("getNamespace"); // cannot be gc()'ed  once in symbol table
     SEXP RCPP = PROTECT( Rf_eval(Rf_lang2( getNamespaceSym, Rf_mkString("Rcpp") ), R_GlobalEnv) ) ;
@@ -93,7 +110,9 @@
     
     // the Rcpp namespace
 	SET_VECTOR_ELT( cache, 0, RCPP ) ;
-	reset_current_error__(cache) ;
+	set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ; // error occured
+	set_current_error( cache, R_NilValue ) ; // current error
+	SET_VECTOR_ELT( cache, 3, R_NilValue ) ; // stack trace
 	SET_VECTOR_ELT( cache, RCPP_HASH_CACHE_INDEX, Rf_allocVector(INTSXP, RCPP_HASH_CACHE_INITIAL_SIZE) ) ;
 	
 	Rf_defineVar( Rf_install(".rcpp_cache"), cache, RCPP );
@@ -102,60 +121,42 @@
 	return cache ;
 }
 
-SEXP reset_current_error__(SEXP cache){
+SEXP reset_current_error(){ 
+    SEXP cache = get_rcpp_cache() ;
     
-    SET_VECTOR_ELT( cache, 1, Rf_ScalarLogical(FALSE) ) ;
+    // error occured
+    set_error_occured( cache, Rf_ScalarLogical(FALSE) ) ;
 	
     // current error
-    SET_VECTOR_ELT( cache, 2, R_NilValue ) ;
+    set_current_error( cache, R_NilValue ) ;
 	
     // stack trace
     SET_VECTOR_ELT( cache, 3, R_NilValue ) ;
 	
     return R_NilValue ;
 }
-SEXP reset_current_error(){ return reset_current_error__( get_rcpp_cache() ) ; }
 
-SEXP rcpp_error_recorder(SEXP e, SEXP cache){
+int error_occured(){
+    SEXP err = VECTOR_ELT( get_rcpp_cache(), 1 ) ;
+    return LOGICAL(err)[0] ;
+}
+
+SEXP rcpp_error_recorder(SEXP e){ 
+    SEXP cache = get_rcpp_cache() ;
+    
     // error occured
-    SET_VECTOR_ELT( cache, 1, Rf_ScalarLogical(TRUE) ) ;
+    set_error_occured( cache, Rf_ScalarLogical(TRUE) ) ;
 	
     // current error
-    rcpp_set_current_error(e ) ;
+    set_current_error(cache, e ) ;
     
     return R_NilValue ;
-	
 }
-SEXP rcpp_error_recorder(SEXP e){ return rcpp_error_recorder(e, get_rcpp_cache() ) ;}
 
-SEXP rcpp_set_current_error(SEXP e, SEXP cache){
-    SET_VECTOR_ELT( cache, 2, e ) ;
-    return R_NilValue ;
-}
-SEXP rcpp_set_current_error(SEXP e){ return rcpp_set_current_error(e, get_rcpp_cache() ) ; }
-
 SEXP rcpp_get_current_error(){
     return VECTOR_ELT( get_rcpp_cache(), 2 ) ;
 }
 
-SEXP rcpp_set_error_occured(SEXP e){
-    SET_VECTOR_ELT( get_rcpp_cache(), 1, e ) ;
-    return R_NilValue ;
-}
-
-SEXP rcpp_get_error_occured(){
-    return VECTOR_ELT( get_rcpp_cache(), 1 ) ;
-}
-
-SEXP rcpp_set_stack_trace(SEXP e){
-    SET_VECTOR_ELT( get_rcpp_cache(), 3, e ) ;
-    return R_NilValue ;
-}
-
-SEXP rcpp_get_stack_trace(){
-    return VECTOR_ELT( get_rcpp_cache(), 3 ) ;
-}
-
 int* get_cache( int m){
     SEXP cache = get_rcpp_cache() ;
     SEXP hash_cache = VECTOR_ELT( cache, RCPP_HASH_CACHE_INDEX) ;

Modified: pkg/Rcpp/src/internal.h
===================================================================
--- pkg/Rcpp/src/internal.h	2012-12-15 22:12:38 UTC (rev 4160)
+++ pkg/Rcpp/src/internal.h	2012-12-15 22:41:37 UTC (rev 4161)
@@ -63,10 +63,8 @@
     
     CALLFUN_0(reset_current_error);
     CALLFUN_1(rcpp_error_recorder);
-    CALLFUN_1(rcpp_set_current_error);
     CALLFUN_0(rcpp_get_current_error);
-    CALLFUN_1(rcpp_set_error_occured);
-    CALLFUN_0(rcpp_get_error_occured);
+    int error_occured() ;
     CALLFUN_1(rcpp_set_stack_trace);
     CALLFUN_0(rcpp_get_stack_trace);