[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