[Rcpp-commits] r2103 - in pkg/Rcpp: . R inst inst/include/Rcpp man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 14 11:50:44 CEST 2010
Author: romain
Date: 2010-09-14 11:50:44 +0200 (Tue, 14 Sep 2010)
New Revision: 2103
Added:
pkg/Rcpp/man/CppReferenceMethods.Rd
Modified:
pkg/Rcpp/NAMESPACE
pkg/Rcpp/R/Module.R
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/inst/include/Rcpp/Module.h
pkg/Rcpp/src/Module.cpp
Log:
initial (probably wrong) impl of referenceMethods
Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE 2010-09-14 08:10:41 UTC (rev 2102)
+++ pkg/Rcpp/NAMESPACE 2010-09-14 09:50:44 UTC (rev 2103)
@@ -8,9 +8,12 @@
exportClasses( Module, "C++Class", "C++Object", "C++Function" )
export( Module )
-importFrom( utils, .DollarNames, prompt )
+importFrom( utils, .DollarNames, prompt, packageDescription )
S3method( .DollarNames, "C++Object" )
S3method( .DollarNames, "Module" )
exportMethods( prompt, show )
exportMethods( new, .DollarNames )
+exportMethods( referenceMethods )
+
+
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-09-14 08:10:41 UTC (rev 2102)
+++ pkg/Rcpp/R/Module.R 2010-09-14 09:50:44 UTC (rev 2103)
@@ -191,8 +191,12 @@
moduleName <- get("moduleName", envir = env)
}
else if( identical( typeof( module ), "externalptr" ) ){
- ## Should Module() ever be called with a pointer as argument?
+ ## [john] Should Module() ever be called with a pointer as argument?
## If so, we need a safe check of the pointer's validity
+
+ ## [romain] I don't think we actually can, external pointers
+ ## are stored as void*, they don't know what they are. Or we could
+ ## perhaps keep a vector of all known module pointers
xp <- module
moduleName <- .Call( "Module__name", xp )
module <- new("Module", pointer = xp, packageName = PACKAGE,
@@ -336,3 +340,63 @@
}
} )
+.referenceMethods__cppclass <- function( classDef, where ){
+ xp <- classDef at pointer
+
+ met <- .Call( "CppClass__methods", xp, PACKAGE = "Rcpp" )
+ arity <- .Call( "CppClass__methods_arity", xp, PACKAGE = "Rcpp" )
+ voidness <- .Call( "CppClass__methods_voidness", xp, PACKAGE = "Rcpp" )
+
+ mets <- sapply( met, function( m ){
+ # skeleton
+ f <- function( ){
+ res <- .External( "Class__invoke_method", xp , m, .self at pointer, PACKAGE = "Rcpp" )
+ res
+ }
+
+ 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", xp, m, .self at pointer, ARG) )[ c(1:6, rep(7L, ar )) ]
+ for( i in seq_len(ar) ){
+ ext.call[[ 6 + i ]] <- as.name( paste( "x", i, sep = "" ) )
+ }
+ b[[2]] <- ext.call
+ body( f ) <- b
+ }
+
+ if( voidness[[m]] ){
+ b <- body( f )
+ b[[3]] <- quote( invisible( NULL ) )
+ body( f ) <- b
+ }
+
+ f
+ } )
+
+ props <- .Call( "CppClass__properties", xp, PACKAGE = "Rcpp" )
+ accesors <- lapply( props, function(p){
+
+ getter <- function(){
+ .Call( "CppClass__get", xp, .self at pointer, p, PACKAGE = "Rcpp" )
+ }
+
+ setter <- function(value){
+ .Call( "CppClass__set", xp, .self at pointer, p, value, PACKAGE = "Rcpp" )
+ }
+
+ res <- list( get = getter, set = setter )
+ names( res ) <- methods:::firstCap( p )
+ res
+ } )
+
+ c( mets, accesors, recursive = TRUE )
+
+}
+setMethod( "referenceMethods", "C++Class", .referenceMethods__cppclass )
+
+
+
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-09-14 08:10:41 UTC (rev 2102)
+++ pkg/Rcpp/inst/ChangeLog 2010-09-14 09:50:44 UTC (rev 2103)
@@ -7,6 +7,12 @@
requirement and print a message if necessary (this will only stay for the
interim period while we develop 0.8.7 so that we all are on the same page.
+ * inst/include/Rcpp/Module.h: added methods to class_Base : methods_arity
+ and methods_voidness to query the number of arguments of methods of a class
+ and if the method is void
+
+ * R/Module.R: implement referenceMethods (from methods) for 'C++Class'
+
2010-09-11 Dirk Eddelbuettel <edd at debian.org>
* src/Date.cpp: Add include of unistd.h to make Solaris happy
Modified: pkg/Rcpp/inst/include/Rcpp/Module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Module.h 2010-09-14 08:10:41 UTC (rev 2102)
+++ pkg/Rcpp/inst/include/Rcpp/Module.h 2010-09-14 09:50:44 UTC (rev 2103)
@@ -69,6 +69,8 @@
virtual Rcpp::CharacterVector property_names(){ return Rcpp::CharacterVector(0) ; }
virtual bool property_is_readonly(const std::string& ) throw(std::range_error) { return false ; }
virtual std::string property_class(const std::string& ) throw(std::range_error){ return "" ; }
+ virtual Rcpp::IntegerVector methods_arity(){ return Rcpp::IntegerVector(0) ; }
+ virtual Rcpp::LogicalVector methods_voidness(){ return Rcpp::LogicalVector(0); }
virtual Rcpp::CharacterVector complete(){ return Rcpp::CharacterVector(0) ; }
virtual ~class_Base(){}
@@ -246,6 +248,32 @@
return out ;
}
+ Rcpp::IntegerVector methods_arity(){
+ int n = methods.size() ;
+ Rcpp::CharacterVector mnames(n) ;
+ Rcpp::IntegerVector res( n );
+ typename METHOD_MAP::iterator it = methods.begin( ) ;
+ for( int i=0; i<n; i++, ++it){
+ mnames[i] = it->first ;
+ res[i] = it->second->nargs() ;
+ }
+ res.names( ) = mnames ;
+ return res ;
+ }
+ Rcpp::LogicalVector methods_voidness(){
+ int n = methods.size() ;
+ Rcpp::CharacterVector mnames(n) ;
+ Rcpp::LogicalVector res( n );
+ typename METHOD_MAP::iterator it = methods.begin( ) ;
+ for( int i=0; i<n; i++, ++it){
+ mnames[i] = it->first ;
+ res[i] = it->second->is_void() ;
+ }
+ res.names( ) = mnames ;
+ return res ;
+ }
+
+
Rcpp::CharacterVector property_names(){
int n = properties.size() ;
Rcpp::CharacterVector out(n) ;
Added: pkg/Rcpp/man/CppReferenceMethods.Rd
===================================================================
--- pkg/Rcpp/man/CppReferenceMethods.Rd (rev 0)
+++ pkg/Rcpp/man/CppReferenceMethods.Rd 2010-09-14 09:50:44 UTC (rev 2103)
@@ -0,0 +1,17 @@
+\name{referenceMethods-methods}
+\docType{methods}
+\alias{referenceMethods,C++Class-method}
+\title{generate reference methods proxies for C++ classes}
+\description{
+ generate reference methods proxies for C++ classes exposed
+ by Rcpp modules
+}
+\section{Methods}{
+\describe{
+
+\item{\code{signature(classDef = "C++Class")}}{
+generate reference methods proxies for C++ classes
+}
+}}
+\keyword{methods}
+
Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp 2010-09-14 08:10:41 UTC (rev 2102)
+++ pkg/Rcpp/src/Module.cpp 2010-09-14 09:50:44 UTC (rev 2103)
@@ -56,6 +56,14 @@
RCPP_FUNCTION_1( Rcpp::CharacterVector, CppClass__properties, XP_Class cl){
return cl->property_names() ;
}
+RCPP_FUNCTION_1( Rcpp::IntegerVector, CppClass__methods_arity, XP_Class cl){
+ return cl->methods_arity() ;
+}
+RCPP_FUNCTION_1( Rcpp::LogicalVector, CppClass__methods_voidness, XP_Class cl){
+ return cl->methods_voidness() ;
+}
+
+
RCPP_FUNCTION_2( bool, CppClass__property_is_readonly, XP_Class cl, std::string p){
return cl->property_is_readonly(p) ;
}
More information about the Rcpp-commits
mailing list