better implementation, and dropping the special handling for 'data'

romainfrancois · romainfrancois · commit 9cfabf8d6deb · 2013-10-01T18:35:39.000+02:00
diff --git a/R/Attributes.R b/R/Attributes.R
@@ -402,21 +402,12 @@ registerPlugin <- function(name, plugin) {
 
 # Take an empty function body and connect it to the specified external symbol
 sourceCppFunction <- function(func, isVoid, dll, symbol) {
-
     args <- names(formals(func))
     if( identical( args, "..." ) ){
         body <- substitute({
-            dots <- as.list( sys.call()[-1L] )
-            parent_frame <- parent.frame()
-            if( "data" %in% names(dots) ){
-                data <- eval( dots[["data"]], parent_frame )
-                dots <- dots[ names(dots) != "data"&nbsp;]
-                env <- as.environment(data)
-                parent.env(env) <- parent_frame
-            } else {
-                env <- parent_frame 
-            }
-            DOT_CALL( FUN, dots, env )
+            calls  <- sys.calls()
+            frames <- sys.frames()
+            DOT_CALL( FUN, calls, frames )
         }, list( FUN = getNativeSymbolInfo(symbol, dll)$address, DOT_CALL = .Call) )
     } else {
     
diff --git a/inst/include/Rcpp/Dots.h b/inst/include/Rcpp/Dots.h
@@ -22,29 +22,64 @@ namespace Rcpp{
 
     class Dots {
     public:
-        Dots( List data_, Environment env_): data(data_), env(env_){}
         
-        SEXP eval( int i ){ return eval_(i); }
+        Dots( List calls_, List frames_ ) : 
+            calls(calls_), frames(frames_), env(0), exprs(0), tags(0)
+        {
+            init() ;
+        }
+            
+        SEXP eval(int i){
+            return Rf_eval( exprs[i], env[i] );   
+        }
         
-        template <typename T>
-        T eval( int i ){
-            return as<T>( eval_(i) ) ;
+        SEXP envir(int i){
+            return env[i] ;    
         }
         
-        SEXP operator[]( int i ){ 
-            return data[i] ;
+        SEXP expr( int i ){ 
+            return exprs[i] ;
         }
         
-        inline size_t size() const{ return data.size(); } 
-            
+        inline size_t size() const{ return exprs.size(); } 
+        
+        
     private:
         
-        inline SEXP eval_( int i){
-            return Rf_eval( data[i], env ) ;
+        void init(){
+            process( frames.size() - 1 ) ;
         }
         
-        List data ;
-        Environment env ;
+        void process(int i){
+            if( i < 0 ) return ;
+            SEXP p = calls[i] ;
+            if( TYPEOF(p) != LANGSXP ) return ;
+            
+            p = CDR(p) ;
+            SEXP head ;
+            while( p != R_NilValue ){
+                head = CAR(p) ;
+                if( is_ellipsis(head) ) {
+                    process(i-1) ;
+                } else {
+                    exprs.push_back( head ) ;
+                    env.push_back( frames[i-1] ) ;
+                    tags.push_back( TAG(p) );
+                }
+                p = CDR(p) ;
+            }
+        }
+        
+        bool is_ellipsis( SEXP x){
+             return x == R_DotsSymbol ;   
+        }
+        
+        List calls, frames ;
+        // all of what we put in there is already protected by R. 
+        std::vector<SEXP> env ;
+        std::vector<SEXP> exprs ;
+        std::vector<SEXP> tags ;
+        
     } ;
 
 } // Rcpp 
diff --git a/src/attributes.cpp b/src/attributes.cpp
@@ -2161,7 +2161,7 @@ namespace attributes {
             const std::vector<Argument>& arguments = function.arguments();
             // deal with functions with a single argument of class "Dots"
             if( function.is_Dots() ){
-                ostrArgs << "SEXP args, SEXP env" ;
+                ostrArgs << "SEXP calls, SEXP frames" ;
             } else {
                 for (size_t i = 0; i<arguments.size(); i++) {
                     const Argument& argument = arguments[i];
@@ -2179,7 +2179,7 @@ namespace attributes {
             if (!cppInterface)
                 ostr << "        Rcpp::RNGScope __rngScope;" << std::endl;
             if( function.is_Dots() ){
-                ostr << "        Rcpp::Dots dots( args, env ) ;" << std::endl;
+                ostr << "        Rcpp::Dots dots( calls, frames ) ;" << std::endl;
             } else {
                 for (size_t i = 0; i<arguments.size(); i++) {
                     const Argument& argument = arguments[i];
