[Rcpp-commits] r1083 - deprecated pkg/Rcpp/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Apr 19 13:11:52 CEST 2010


Author: romain
Date: 2010-04-19 13:11:52 +0200 (Mon, 19 Apr 2010)
New Revision: 1083

Added:
   deprecated/hack.inline.R
Modified:
   pkg/Rcpp/R/cppfunction.R
Log:
move the inline hack away

Added: deprecated/hack.inline.R
===================================================================
--- deprecated/hack.inline.R	                        (rev 0)
+++ deprecated/hack.inline.R	2010-04-19 11:11:52 UTC (rev 1083)
@@ -0,0 +1,33 @@
+
+hack_compileCode <- function(){
+	inline <- asNamespace( "inline" )
+	
+	unlockBinding( "compileCode", inline )
+	compileCode <- get("compileCode", 	inline )
+	exprs <- append( 
+		list( as.name("{"), parse(text="code <- Rcpp:::compileCode_hook(f, code)")[[1]] ) , 
+		as.list( body( compileCode )[-1] )
+		)
+	body( compileCode ) <- as.call( exprs )
+	assignInNamespace( "compileCode", compileCode, inline )
+	unlockBinding( "compileCode", inline )
+}
+
+compileCode_hook <- function( f, code){
+	# we only do something if we are called from cppfunction
+	calls <- sys.calls()
+	functions <- sapply( calls, function(.){ if( is.name(.[[1]]) ) as.character( .[[1]]) else "" } )
+	if( "cppfunction" %in% functions ){
+sprintf( 
+'%s
+#if defined(WIN32)
+extern "C" void R_init_%s( DllInfo* info ){
+	std::set_terminate( forward_uncaught_exceptions_to_r ) ;
+}
+#endif
+', code, f )
+	} else {
+		code
+	}
+}
+

Modified: pkg/Rcpp/R/cppfunction.R
===================================================================
--- pkg/Rcpp/R/cppfunction.R	2010-04-19 11:08:38 UTC (rev 1082)
+++ pkg/Rcpp/R/cppfunction.R	2010-04-19 11:11:52 UTC (rev 1083)
@@ -18,11 +18,8 @@
 NAMESPACE <- environment()
 HAVEINLINE <- FALSE
 cfunction <- function(...) stop( "inline not available" )
-compileCode <- function(...) stop( "inline not available" )
 
 init.inline <- function(){
-	hack_compileCode()
-
 	unlockBinding( "HAVEINLINE", NAMESPACE )
 	unlockBinding( "cfunction", NAMESPACE )
 	assignInNamespace( "HAVEINLINE", TRUE, NAMESPACE )
@@ -31,38 +28,6 @@
 	lockBinding( "cfunction", NAMESPACE )
 }
 
-hack_compileCode <- function(){
-	inline <- asNamespace( "inline" )
-	
-	unlockBinding( "compileCode", inline )
-	compileCode <- get("compileCode", 	inline )
-	exprs <- append( 
-		list( as.name("{"), parse(text="code <- Rcpp:::compileCode_hook(f, code)")[[1]] ) , 
-		as.list( body( compileCode )[-1] )
-		)
-	body( compileCode ) <- as.call( exprs )
-	assignInNamespace( "compileCode", compileCode, inline )
-	unlockBinding( "compileCode", inline )
-}
-
-compileCode_hook <- function( f, code){
-	# we only do something if we are called from cppfunction
-	calls <- sys.calls()
-	functions <- sapply( calls, function(.){ if( is.name(.[[1]]) ) as.character( .[[1]]) else "" } )
-	if( "cppfunction" %in% functions ){
-sprintf( 
-'%s
-#if defined(WIN32)
-extern "C" void R_init_%s( DllInfo* info ){
-	std::set_terminate( forward_uncaught_exceptions_to_r ) ;
-}
-#endif
-', code, f )
-	} else {
-		code
-	}
-}
-
 cppfunction <- function (sig = character(), body = character(), includes = character(), 
     otherdefs = character(), verbose = FALSE, 
     cppargs = character(), cxxargs = character(), libargs = character(), 



More information about the Rcpp-commits mailing list