[Rcpp-commits] r2518 - scripts

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

Author: romain
Date: 2010-11-25 12:06:36 +0100 (Thu, 25 Nov 2010)
New Revision: 2518

Modified:
   scripts/generator_Module_CppFunction.R
   scripts/generator_Module_function.R
Log:
update

Modified: scripts/generator_Module_CppFunction.R
===================================================================
--- scripts/generator_Module_CppFunction.R	2010-11-25 11:06:04 UTC (rev 2517)
+++ scripts/generator_Module_CppFunction.R	2010-11-25 11:06:36 UTC (rev 2518)
@@ -40,6 +40,49 @@
 		void (*ptr_fun)(%s) ;	
 } ;
 
+
+
+template <typename OUT, %s>
+class CppFunction_WithFormals%d : public CppFunction {
+	public:
+
+		CppFunction_WithFormals%d(OUT (*fun)(%s) , Rcpp::List formals_, const char* docstring = 0) : 
+		    CppFunction(docstring), formals(formals_), ptr_fun(fun){}
+		
+		SEXP operator()(SEXP* args) throw(std::exception){
+			return Rcpp::wrap( ptr_fun( %s ) ) ;
+		}
+		
+		inline int nargs(){ return %d; }
+		const char* signature(const char* name){ return Rcpp::signature<OUT,%s>(name) ; }
+		SEXP get_formals(){ return formals; }
+		
+	private:
+		Rcpp::List formals ;
+		OUT (*ptr_fun)(%s) ;
+} ;
+
+template <%s>
+class CppFunction_WithFormals%d<void,%s> : public CppFunction {
+	public:
+		CppFunction_WithFormals%d(void (*fun)(%s), Rcpp::List formals_, const char* docstring = 0) : 
+		    CppFunction(docstring), formals(formals_), ptr_fun(fun){}
+		
+		SEXP operator()(SEXP* args) throw(std::exception) {
+			ptr_fun( %s ) ;
+			return R_NilValue ;
+		}
+		
+		inline int nargs(){ return %d; }
+		inline bool is_void(){ return true; }
+		const char* signature(const char* name){ return Rcpp::signature<void_type,%s>(name) ; }
+		SEXP get_formals(){ return formals; }
+		
+	private:
+		Rcpp::List formals ;
+		void (*ptr_fun)(%s) ;	
+} ;
+
 ',
 collapse( sprintf( "typename U%d", index ) ), 
 i,
@@ -50,6 +93,7 @@
 collapse( sprintf( "U%d", index ) ), 
 collapse( sprintf( "U%d", index ) ), 
 
+
 paste( sprintf( "typename U%d", index ), collapse = ", " ), 
 i, 
 collapse( sprintf( "U%d", index ) ), 
@@ -58,6 +102,27 @@
 collapse( sprintf( "Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U%d>::type >( args[%d] )", index, index ) ),
 i, 
 collapse( sprintf( "U%d", index ) ), 
+collapse( sprintf( "U%d", index ) ), 
+
+# _ WithFormals
+collapse( sprintf( "typename U%d", index ) ), 
+i,
+i, 
+collapse( sprintf( "U%d", index ) ),
+collapse( sprintf( "Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U%d >::type >( args[%d] )", index, index ) ),
+i, 
+collapse( sprintf( "U%d", index ) ), 
+collapse( sprintf( "U%d", index ) ), 
+
+
+paste( sprintf( "typename U%d", index ), collapse = ", " ), 
+i, 
+collapse( sprintf( "U%d", index ) ), 
+i, 
+collapse( sprintf( "U%d", index ) ), 
+collapse( sprintf( "Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U%d>::type >( args[%d] )", index, index ) ),
+i, 
+collapse( sprintf( "U%d", index ) ), 
 collapse( sprintf( "U%d", index ) )
 )
 	
@@ -122,6 +187,41 @@
 		void (*ptr_fun)(void) ;	
 } ;
 
+
+template <typename OUT>
+class CppFunction_WithFormals0 : public CppFunction {
+	public:
+		CppFunction_WithFormals0(OUT (*fun)(void), Rcpp::List,  const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){}
+		SEXP operator()(SEXP*) throw(std::range_error) {
+			return Rcpp::wrap( ptr_fun() ) ;
+		}
+		
+		inline int nargs(){ return 0; }
+		const char* signature(const char* name){ return Rcpp::signature<OUT>(name) ; }
+		
+	private:
+		OUT (*ptr_fun)(void) ;	                    
+} ;
+
+
+template <>
+class CppFunction_WithFormals0<void> : public CppFunction {
+	public:
+		CppFunction_WithFormals0(void (*fun)(void), Rcpp::List, const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){} ;
+		
+		SEXP operator()(SEXP*) throw(std::exception) {
+			ptr_fun() ;
+			return R_NilValue ;
+		}
+		
+		inline int nargs(){ return 0; }
+		inline bool is_void(){ return true; }
+		const char* signature(const char* name){ return Rcpp::signature<void_type>(name) ; }
+		
+	private:
+		void (*ptr_fun)(void) ;	
+} ;
+
 %s
 
 #endif

Modified: scripts/generator_Module_function.R
===================================================================
--- scripts/generator_Module_function.R	2010-11-25 11:06:04 UTC (rev 2517)
+++ scripts/generator_Module_function.R	2010-11-25 11:06:36 UTC (rev 2518)
@@ -1,6 +1,10 @@
 
 fun <- function( i ){
 	
+    typename <- if( i == 0 ) "" else paste( ",", paste( sprintf( "typename U%d", (1:i)-1 ), collapse = ", " ) , sep = "" )
+    Uu <- if( i == 0 ) "void" else paste( sprintf( "U%d u%d", (1:i)-1, (1:i)-1 ), collapse = ", " )
+    U <- if( i == 0 ) "" else paste( ",", paste( sprintf( "U%d", (1:i)-1 ), collapse = ", " ) , sep = "" )
+    
 txt <- sprintf( '
 template <typename OUT%s>                                                                   
 void function( const char* name_,  OUT (*fun)(%s), const char* docstring = 0){
@@ -9,11 +13,24 @@
     scope->Add( name_, new CppFunction%d<OUT%s>( fun, docstring ) ) ;
   }
 }
+
+template <typename OUT%s>                                                                   
+void function( const char* name_,  OUT (*fun)(%s), Rcpp::List formals, const char* docstring = 0){
+  Rcpp::Module* scope = ::getCurrentScope() ;
+  if( scope ){
+    scope->Add( name_, new CppFunction_WithFormals%d<OUT%s>( fun, formals, docstring ) ) ;
+  }
+}
 ', 
-if( i == 0 ) "" else paste( ",", paste( sprintf( "typename U%d", (1:i)-1 ), collapse = ", " ) , sep = "" ), 
-if( i == 0 ) "void" else paste( sprintf( "U%d u%d", (1:i)-1, (1:i)-1 ), collapse = ", " ), 
+typename, 
+Uu, 
 i, 
-if( i == 0 ) "" else paste( ",", paste( sprintf( "U%d", (1:i)-1 ), collapse = ", " ) , sep = "" )
+U, 
+
+typename, 
+Uu, 
+i, 
+U
 )
 	
 }