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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Apr 15 10:29:23 CEST 2010


Author: romain
Date: 2010-04-15 10:29:22 +0200 (Thu, 15 Apr 2010)
New Revision: 1043

Modified:
   pkg/Rcpp/R/cpp_function.R
   pkg/Rcpp/R/zzz.R
Log:
s/cpp_function/cppfunction/ and restrict it to C++/.Call/Rcpp=TRUE

Modified: pkg/Rcpp/R/cpp_function.R
===================================================================
--- pkg/Rcpp/R/cpp_function.R	2010-04-15 08:10:34 UTC (rev 1042)
+++ pkg/Rcpp/R/cpp_function.R	2010-04-15 08:29:22 UTC (rev 1043)
@@ -15,23 +15,39 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-cpp_function <- function(..., .Cpp = TRUE){
-	ok <- FALSE
-	if( "package:inline" %in% search() ){
-		ok <- TRUE
-	} else{
-		ok <- tryCatch( {
-			require( "inline" )
-			TRUE 
-		} , error = function(e) FALSE )
+HAVEINLINE <- FALSE
+cfunction <- function(...) stop( "inline not available" ) 
+
+cppfunction <- function (sig = character(), body = character(), includes = character(), 
+    otherdefs = character(), verbose = FALSE, 
+    cppargs = character(), cxxargs = character(), libargs = character(), 
+    .Cpp = TRUE){
+	
+    ok <- HAVEINLINE
+	if( !ok){
+		if( "package:inline" %in% search() ){
+			ok <- TRUE
+		} else{
+			ok <- tryCatch( {
+				require( "inline" )
+				TRUE 
+			} , error = function(e) FALSE )
+		}
+		if( ! ok ){
+			stop( "package inline is not available" )	
+		}
+		HAVEINLINE <<- TRUE
+		cfunction <<- get( "cfunction", asNamespace( "inline" ) )
 	}
-	if( ! ok ){
-		stop( "package inline is not available" )	
-	}
-	cfunction <- get( "cfunction", asNamespace( "inline" ) )
-	fx <- cfunction( ... )
+	fx <- cfunction( sig = sig, body = body, includes = includes, 
+		otherdefs = otherdefs, language = "C++", convention = ".Call", 
+		Rcpp = TRUE, cppargs = cppargs, cxxargs = cxxargs, libargs = libargs, 
+		verbose = verbose )
+	)
 	if( isTRUE( .Cpp ) ){
 		# replace .Call by Rcpp::.Cpp
+		# this is somewhat heuristic, maybe we should search for .Call as opposed
+		# to assume it is in this position
 		body( fx at .Data )[[4]][[1]] <- call( "::", as.name("Rcpp"), as.name(".Cpp") )
 	}
 	fx

Modified: pkg/Rcpp/R/zzz.R
===================================================================
--- pkg/Rcpp/R/zzz.R	2010-04-15 08:10:34 UTC (rev 1042)
+++ pkg/Rcpp/R/zzz.R	2010-04-15 08:29:22 UTC (rev 1043)
@@ -17,5 +17,9 @@
 
 .onLoad <- function(libname, pkgname){
 	.Call( "initRcpp", PACKAGE = pkgname )
+	if( "package:inline" %in% search() ){
+		HAVEINLINE <<- TRUE	
+		cfunction <<- get( "cfunction", asNamespace( "inline" ) )
+	}
 }
 



More information about the Rcpp-commits mailing list