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

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

Author: romain
Date: 2010-04-14 14:41:13 +0200 (Wed, 14 Apr 2010)
New Revision: 1041

Added:
   pkg/Rcpp/R/cpp_function.R
Log:
cpp_function which calls inline::cfunction but replaces .Call by Rcpp::.Cpp

Added: pkg/Rcpp/R/cpp_function.R
===================================================================
--- pkg/Rcpp/R/cpp_function.R	                        (rev 0)
+++ pkg/Rcpp/R/cpp_function.R	2010-04-14 12:41:13 UTC (rev 1041)
@@ -0,0 +1,38 @@
+# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# Rcpp is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# 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 )
+	}
+	if( ! ok ){
+		stop( "package inline is not available" )	
+	}
+	cfunction <- get( "cfunction", asNamespace( "inline" ) )
+	fx <- cfunction( ... )
+	if( isTRUE( .Cpp ) ){
+		# replace .Call by Rcpp::.Cpp
+		body( fx at .Data )[[4]][[1]] <- call( "::", as.name("Rcpp"), as.name(".Cpp") )
+	}
+	fx
+}