[Rcpp-commits] r2288 - pkg/Rcpp/R

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

Author: jmc
Date: 2010-10-07 23:10:04 +0200 (Thu, 07 Oct 2010)
New Revision: 2288

Modified:
   pkg/Rcpp/R/Module.R
Log:
insert direct .External into method invocation

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2010-10-07 14:42:23 UTC (rev 2287)
+++ pkg/Rcpp/R/Module.R	2010-10-07 21:10:04 UTC (rev 2288)
@@ -157,7 +157,7 @@
         clname <- as.character(CLASS)
 
         fields <- cpp_fields( CLASS, where )
-        methods <- cpp_refMethods(CLASS at pointer, CLASS at methods, where)
+        methods <- cpp_refMethods(CLASS, where)
         generator <- setRefClass( clname,
                                  fields = fields,
                                  contains = "C++Object",
@@ -200,25 +200,29 @@
     module
 }
 
-## create a named list of the R methods to invoke C++ methods
-## from the C++ class with pointer xp
-cpp_refMethods <- function(xp, cpp_methods, where) {
-
-	method_wrapper <- function( METHOD ){
-	    here <- environment()
-	    eval( substitute(
-            function(...) {
-                res <- MET$invoke( .pointer, ... )
-                RES
-            },
+method_wrapper <- function( METHOD, where ){
+            f <- function(...) NULL
+	    extCall <- substitute(
+                .External(CppMethod__invoke, class_pointer, pointer, .pointer, ...)
+           ,
             list(
-                MET = METHOD,
-                RES = if( METHOD$void ) quote(invisible(NULL)) else as.name("res")
+                class_pointer = METHOD$class_pointer,
+                pointer = METHOD$pointer,
+                CppMethod__invoke = CppMethod__invoke
+                 )
             )
-	    ), here )
+            if( METHOD$void )
+                extCall <- substitute({
+                    CALL
+                    invisible(NULL)
+                }, list(CALL = extCall))
+            body(f, where) <- extCall
+            f
 	}
-	mets <- sapply( cpp_methods, method_wrapper )
-    mets
+## create a named list of the R methods to invoke C++ methods
+## from the C++ class with pointer xp
+cpp_refMethods <- function(CLASS, where) {
+    sapply( CLASS at methods, method_wrapper, where = where )
 }
 
 binding_maker <- function( FIELD, where ){