[Rcpp-commits] r2130 - in pkg/Rcpp: R inst/include/Rcpp src

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

Author: romain
Date: 2010-09-17 13:43:06 +0200 (Fri, 17 Sep 2010)
New Revision: 2130

Modified:
   pkg/Rcpp/R/Module.R
   pkg/Rcpp/inst/include/Rcpp/Module.h
   pkg/Rcpp/src/Module.cpp
Log:
remove CppClass__invoke

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2010-09-17 11:30:37 UTC (rev 2129)
+++ pkg/Rcpp/R/Module.R	2010-09-17 11:43:06 UTC (rev 2130)
@@ -254,11 +254,7 @@
 .referenceMethods__cppclass <- function( classDef, where ){
     xp <- classDef at pointer
     cpp_methods <- classDef at cpp_methods
-    
-    # met <- .Call( "CppClass__methods", xp, PACKAGE = "Rcpp" )
-    # arity <- .Call( "CppClass__methods_arity", xp, PACKAGE = "Rcpp" )
-	# voidness <- .Call( "CppClass__methods_voidness", xp, PACKAGE = "Rcpp" )
-	
+
 	method_wrapper <- function( METHOD ){
 	    here <- environment()
 	    eval( substitute(
@@ -273,39 +269,7 @@
 	    ), here )
 	}
 	mets <- sapply( cpp_methods, method_wrapper )
-	
-	# mets <- sapply( cpp_methods, function( m ){
-	#     # skeleton that gets modified below
-	#     f <- function( ){
-	#         res <- .External( "Class__invoke_method", .self at cppclass , m, .self at pointer, PACKAGE = "Rcpp" )
-	#         res
-	#     }
-	#     body( f )[[2]][[3]][[4]] <- m 
-	#     
-	#     if( ar <- arity[[ m ]] ){
-	#         # change the formal arguments
-	#         formals( f ) <- structure( rep( alist( . = ), ar ), names = sprintf( "x%d", seq_len(ar) ) )
-	#     
-	#         # change the body
-	#         b <- body( f )
-	#         ext.call <- quote( .External( "Class__invoke_method", PACKAGE="Rcpp", .self at cppclass, m, .self at pointer, ARG) )[ c(1:6, rep(7L, ar )) ]
-	#         ext.call[[5]] <- m
-	#         for( i in seq_len(ar) ){
-	#             ext.call[[ 6 + i ]] <- as.name( paste( "x", i, sep = "" ) )
-	#         }
-	#         b[[2]][[3]] <- ext.call
-	#         body( f ) <- b
-	#     }
-	#     
-	#     if( voidness[[m]] ){
-	#         b <- body( f )
-	#         b[[3]] <- quote( invisible( NULL ) )
-	#         body( f ) <- b
-	#     }
-	#     
-	#     f
-	# } )
-	     
+		     
 	# [romain] commenting out fields get/set 
 	#          because they are not used anyway, they lose over the default 
 	#          getters and setters installed by setRefClass

Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-17 11:30:37 UTC (rev 2129)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h	2010-09-17 11:43:06 UTC (rev 2130)
@@ -65,12 +65,9 @@
 	virtual SEXP newInstance(SEXP *, int){ 
 		return R_NilValue;
 	}
-	virtual SEXP invoke( const std::string&, SEXP, SEXP *, int ){ 
+	virtual SEXP invoke( SEXP, SEXP, SEXP *, int ){ 
 		return R_NilValue ;
 	}
-	virtual SEXP invoke__( SEXP, SEXP, SEXP *, int ){ 
-		return R_NilValue ;
-	}
 	
 	virtual Rcpp::CharacterVector method_names(){ return Rcpp::CharacterVector(0) ; }
 	virtual Rcpp::CharacterVector property_names(){ return Rcpp::CharacterVector(0) ; }
@@ -225,22 +222,8 @@
 		return out ;
 	}
 	
-	SEXP invoke( const std::string& method_name, SEXP object, SEXP *args, int nargs ){ 
+	SEXP invoke( SEXP method_xp, SEXP object, SEXP *args, int nargs ){ 
 		BEGIN_RCPP
-		typename METHOD_MAP::iterator it = methods.find( method_name ) ;
-		if( it == methods.end() ){
-			throw std::range_error( "no such method" ) ; 
-		}
-		method_class* met =  it->second ;
-		if( met->nargs() > nargs ){
-			throw std::range_error( "incorrect number of arguments" ) ; 	
-		}
-		return met->operator()( XP(object), args ) ;
-		END_RCPP	
-	}
-	
-	SEXP invoke__( SEXP method_xp, SEXP object, SEXP *args, int nargs ){ 
-		BEGIN_RCPP
 		method_class* met = reinterpret_cast< method_class* >( EXTPTR_PTR( method_xp ) ) ;
 	    // maybe this is not needed as the R side handles it
 		if( met->nargs() > nargs ){

Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp	2010-09-17 11:30:37 UTC (rev 2129)
+++ pkg/Rcpp/src/Module.cpp	2010-09-17 11:43:06 UTC (rev 2130)
@@ -149,25 +149,6 @@
    	return clazz->newInstance(cargs, nargs ) ;
 }
 
-// Deprecated in favour of the CppMethod__invoke
-extern "C" SEXP Class__invoke_method(SEXP args){
-	SEXP p = CDR(args) ;
-	
-	XP_Class clazz( CAR(p) ) ; p = CDR(p);
-	std::string met = Rcpp::as<std::string>( CAR(p) ) ; p = CDR(p) ;
-	SEXP obj = CAR(p); p = CDR(p) ;
-	
-	SEXP cargs[MAX_ARGS] ;
-    int nargs = 0 ;
-   	for(; nargs<MAX_ARGS; nargs++){
-   		if( p == R_NilValue ) break ;
-   		cargs[nargs] = CAR(p) ;
-   		p = CDR(p) ;
-   	}
-   	
-   	return clazz->invoke( met, obj, cargs, nargs ) ;
-}
-
 extern "C" SEXP CppMethod__invoke(SEXP args){
 	SEXP p = CDR(args) ;
 	
@@ -189,7 +170,7 @@
    		p = CDR(p) ;
    	}
    	
-   	return clazz->invoke__( met, obj, cargs, nargs ) ;
+   	return clazz->invoke( met, obj, cargs, nargs ) ;
 }