inline/DESCRIPTION0000644000175000017500000000112712201150464012150 0ustar00eddeddPackage: inline Version: 0.3.13 Date: $Date: 2013-08-08 17:25:19 -0500 (Thu, 08 Aug 2013) $ Title: Inline C, C++, Fortran function calls from R Author: Oleg Sklyar, Duncan Murdoch, Mike Smith, Dirk Eddelbuettel, Romain Francois Maintainer: Dirk Eddelbuettel Depends: R (>= 2.4.0), methods Suggests: Rcpp (>= 0.8.0) Description: Functionality to dynamically define R functions and S4 methods with in-lined C, C++ or Fortran code supporting .C and .Call calling conventions. License: LGPL Copyright: Oleg Sklyar, 2005-2010 LazyLoad: yes Packaged: 2013-08-09 11:23:32.75377 UTC; edd inline/NAMESPACE0000644000175000017500000000031612032665742011674 0ustar00eddeddimport("methods") importFrom( "utils", "package.skeleton" ) export( "cfunction", "cxxfunction", "getPlugin", "registerPlugin", "rcpp" ) exportMethods( "setCMethod", "getDynLib", "package.skeleton" ) inline/R/0000755000175000017500000000000012201014202010627 5ustar00eddeddinline/R/cfunction.R0000644000175000017500000002675212201014202012756 0ustar00eddedd# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## CFunc is an S4 class derived from 'function'. This inheritance allows objects ## to behave exactly as functions do, but it provides a slot @code that keeps the ## source C or Fortran code used to create the inline call setClass("CFunc", representation( code="character" ), contains="function" ) setClass( "CFuncList", contains = "list" ) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - cfunction <- function(sig=character(), body=character(), includes=character(), otherdefs=character(), language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), Rcpp=FALSE, cppargs=character(), cxxargs=character(), libargs=character()) { convention <- match.arg(convention) if ( missing(language) ) language <- ifelse(convention == ".Fortran", "Fortran", "C++") else language <- match.arg(language) language <- switch(EXPR=tolower(language), cpp="C++", f="Fortran", f95="F95", objc="ObjectiveC", objcpp= ,"objc++"="ObjectiveC++", language) f <- basename(tempfile()) if ( !is.list(sig) ) { sig <- list(sig) names(sig) <- f names(body) <- f } if( length(sig) != length(body) ) stop("mismatch between the number of functions declared in 'sig' and the number of function bodies provided in 'body'") if (Rcpp) { if (!require(Rcpp)) stop("Rcpp cannot be loaded, install it or use the default Rcpp=FALSE") cxxargs <- c(Rcpp:::RcppCxxFlags(), cxxargs) # prepend information from Rcpp libargs <- c(Rcpp:::RcppLdFlags(), libargs) # prepend information from Rcpp } if (length(cppargs) != 0) { args <- paste(cppargs, collapse=" ") if (verbose) cat("Setting PKG_CPPFLAGS to", args, "\n") Sys.setenv(PKG_CPPFLAGS=args) } if (length(cxxargs) != 0) { args <- paste(cxxargs, collapse=" ") if (verbose) cat("Setting PKG_CXXFLAGS to", args, "\n") Sys.setenv(PKG_CXXFLAGS=args) } if (length(libargs) != 0) { args <- paste(libargs, collapse=" ") if (verbose) cat("Setting PKG_LIBS to", args, "\n") Sys.setenv(PKG_LIBS=args) } types <- vector(mode="list", length=length(sig)) ## GENERATE THE CODE for ( i in seq_along(sig) ) { ## C/C++ with .Call convention ********************************************* if ( convention == ".Call" ) { ## include R includes, also error if (i == 1) { code <- ifelse(Rcpp, "#include \n", paste("#include \n#include \n", "#include \n", sep="")); ## include further includes code <- paste(c(code, includes, ""), collapse="\n") ## include further definitions code <- paste(c(code, otherdefs, ""), collapse="\n") } ## generate C-function sig from the original sig if ( length(sig[[i]]) > 0 ) { funCsig <- paste("SEXP", names(sig[[i]]), collapse=", " ) } else funCsig <- "" funCsig <- paste("SEXP", names(sig)[i], "(", funCsig, ")", sep=" ") ## add C export of the function if ( language == "C++" || language == "ObjectiveC++") code <- paste( code, "extern \"C\" {\n ", funCsig, ";\n}\n\n", sep="") ## OPEN function code <- paste( code, funCsig, " {\n", sep="") ## add code, split lines code <- paste( code, paste(body[[i]], collapse="\n"), sep="") ## CLOSE function, add return and warning in case the user forgot it code <- paste(code, "\n ", ifelse(Rcpp, "Rf_warning", "warning"), "(\"your C program does not return anything!\");\n return R_NilValue;\n}\n", sep=""); } ## C/C++ with .C convention ************************************************ else if ( convention == ".C" ) { if (i == 1) { ## include only basic R includes code <- ifelse(Rcpp,"#include \n", "#include \n") ## include further includes code <- paste(c(code, includes, ""), collapse="\n") ## include further definitions code <- paste(c(code, otherdefs, ""), collapse="\n") } ## determine function header if ( length(sig[[i]]) > 0 ) { types[[i]] <- pmatch(sig[[i]], c("logical", "integer", "double", "complex", "character", "raw", "numeric"), duplicates.ok = TRUE) if ( any(is.na(types[[i]])) ) stop( paste("Unrecognized type", sig[[i]][is.na(types[[i]])]) ) decls <- c("int *", "int *", "double *", "Rcomplex *", "char **", "unsigned char *", "double *")[ types[[i]] ] funCsig <- paste(decls, names(sig[[i]]), collapse=", ") } else funCsig <- "" funCsig <- paste("void", names(sig)[i], "(", funCsig, ")", sep=" ") if ( language == "C++" || language == "ObjectiveC++" ) code <- paste( code, "extern \"C\" {\n ", funCsig, ";\n}\n\n", sep="") ## OPEN function code <- paste( code, funCsig, " {\n", sep="") ## add code, split lines code <- paste( code, paste(body[[i]], collapse="\n"), sep="") ## CLOSE function code <- paste( code, "\n}\n", sep="") } ## .Fortran convention ***************************************************** else { if (i == 1) { ## no default includes, include further includes code <- paste(includes, collapse="\n") ## include further definitions code <- paste(c(code, otherdefs, ""), collapse="\n") } ## determine function header if ( length(sig[[i]]) > 0 ) { types[[i]] <- pmatch(sig[[i]], c("logical", "integer", "double", "complex", "character", "raw", "numeric"), duplicates.ok = TRUE) if ( any(is.na(types[[i]])) ) stop( paste("Unrecognized type", sig[[i]][is.na(types[[i]])]) ) if (6 %in% types[[i]]) stop( "raw type unsupported by .Fortran()" ) decls <- c("INTEGER", "INTEGER", "DOUBLE PRECISION", "DOUBLE COMPLEX", "CHARACTER*255", "Unsupported", "DOUBLE PRECISION")[ types[[i]] ] decls <- paste(" ", decls, " ", names(sig[[i]]), "(*)", sep="", collapse="\n") funCsig <- paste(names(sig[[i]]), collapse=", ") } else { decls <- "" funCsig <- "" } funCsig <- paste(" SUBROUTINE", names(sig)[i], "(", funCsig, ")\n", sep=" ") ## OPEN function code <- paste( code, funCsig, decls, collapse="\n") ## add code, split lines code <- paste( code, paste(body[[i]], collapse="\n"), sep="") ## CLOSE function code <- paste( code, "\n RETURN\n END\n", sep="") } } ## for along signatures ## WRITE AND COMPILE THE CODE libLFile <- compileCode(f, code, language, verbose) ## SET A FINALIZER TO PERFORM CLEANUP cleanup <- function(env) { if ( f %in% names(getLoadedDLLs()) ) dyn.unload(libLFile) unlink(libLFile) } reg.finalizer(environment(), cleanup, onexit=TRUE) res <- vector("list", length(sig)) names(res) <- names(sig) ## GENERATE R FUNCTIONS for ( i in seq_along(sig) ) { ## Create new objects of class CFunc, each containing the code of ALL inline ## functions. This will be used to recompile the whole shared lib when needed res[[i]] <- new("CFunc", code = code) ## this is the skeleton of the function, the external call is added below using 'body' ## important here: all variables are kept in the local environment fn <- function(arg) { NULL } DLL <- dyn.load( libLFile ) ## Modify the function formals to give the right argument list args <- formals(fn)[ rep(1, length(sig[[i]])) ] names(args) <- names(sig[[i]]) formals(fn) <- args ## create .C/.Call function call that will be added to 'fn' if (convention == ".Call") { body <- quote( CONVENTION("EXTERNALNAME", ARG) )[ c(1:2, rep(3, length(sig[[i]]))) ] for ( j in seq(along = sig[[i]]) ) body[[j+2]] <- as.name(names(sig[[i]])[j]) } else { body <- quote( CONVENTION("EXTERNALNAME", as.logical(ARG), as.integer(ARG), as.double(ARG), as.complex(ARG), as.character(ARG), as.raw(ARG), as.double(ARG)) )[ c(1:2,types[[i]]+2) ] names(body) <- c( NA, "", names(sig[[i]]) ) for ( j in seq(along = sig[[i]]) ) body[[j+2]][[2]] <- as.name(names(sig[[i]])[j]) ## OLD VERSION -- does not work for lists of functions # body <- quote( CONVENTION("EXTERNALNAME", as.logical(ARG), as.integer(ARG), # as.double(ARG), as.complex(ARG), as.character(ARG), # as.raw(ARG), as.double(ARG)) )[ c(1:2,types+2) ] # names(body) <- c( NA, "", names(sig[[i]]) ) # for ( j in seq(along = sig[[i]]) ) body[[j+2]][[2]] <- as.name(names(sig[[i]])[j]) } body[[1]] <- get(convention) body[[2]] <- getNativeSymbolInfo( names(sig)[i], DLL )$address ## update the body of 'fn' body(fn) <- body ## set fn as THE function in CFunc of res[[i]] res[[i]]@.Data <- fn } ## OUTPUT PROGRAM CODE IF DESIRED if ( verbose ) { cat("Program source:\n") lines <- strsplit(code, "\n") for ( i in 1:length(lines[[1]]) ) cat(format(i,width=3), ": ", lines[[1]][i], "\n", sep="") } ## Remove unnecessary objects from the local environment remove(list = c("args", "body", "fn", "funCsig", "i", "includes", "j")) ## RETURN THE FUNCTION if (length(res) == 1 && names(res) == f) return( res[[1]] ) else return( new( "CFuncList", res ) ) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - compileCode <- function(f, code, language, verbose) { wd = getwd() on.exit(setwd(wd)) ## Prepare temp file names if ( .Platform$OS.type == "windows" ) { ## windows files dir <- gsub("\\\\", "/", tempdir()) libCFile <- paste(dir, "/", f, ".EXT", sep="") libLFile <- paste(dir, "/", f, ".dll", sep="") libLFile2 <- paste(dir, "/", f, ".dll", sep="") } else { ## UNIX-alike build libCFile <- paste(tempdir(), "/", f, ".EXT", sep="") libLFile <- paste(tempdir(), "/", f, .Platform$dynlib.ext, sep="") libLFile2 <- paste(tempdir(), "/", f, ".sl", sep="") } extension <- switch(language, "C++"=".cpp", C=".c", Fortran=".f", F95=".f95", ObjectiveC=".m", "ObjectiveC++"=".mm") libCFile <- sub(".EXT$", extension, libCFile) ## Write the code to the temp file for compilation write(code, libCFile) ## Compile the code using the running version of R if several available if ( file.exists(libLFile) ) file.remove( libLFile ) if ( file.exists(libLFile2) ) file.remove( libLFile2 ) setwd(dirname(libCFile)) errfile <- paste( basename(libCFile), ".err.txt", sep = "" ) cmd <- paste(R.home(component="bin"), "/R CMD SHLIB ", basename(libCFile), " 2> ", errfile, sep="") if (verbose) cat("Compilation argument:\n", cmd, "\n") compiled <- system(cmd, intern=!verbose) errmsg <- readLines( errfile ) unlink( errfile ) writeLines( errmsg ) setwd(wd) if ( !file.exists(libLFile) && file.exists(libLFile2) ) libLFile <- libLFile2 if ( !file.exists(libLFile) ) { cat("\nERROR(s) during compilation: source code errors or compiler configuration errors!\n") cat("\nProgram source:\n") code <- strsplit(code, "\n") for (i in 1:length(code[[1]])) cat(format(i,width=3), ": ", code[[1]][i], "\n", sep="") stop( paste( "Compilation ERROR, function(s)/method(s) not created!", paste( errmsg , collapse = "\n" ) ) ) } return( libLFile ) } inline/R/cmethods.R0000644000175000017500000000347011400243654012603 0ustar00eddedd# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setGeneric( "setCMethod", function(f, sig, body, ...) standardGeneric("setCMethod") ) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setMethod( "setCMethod", signature(f="character", sig="list", body="list"), function(f, sig, body, includes="", otherdefs="", language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), where=topenv(.GlobalEnv), ...) { if ( length(f) != length(sig) || length(sig) != length(body) ) stop("number of signatures does not correspond to the number of code chunks") names(sig) <- f fns <- cfunction(sig, body, includes, otherdefs, language, verbose, convention) if ( verbose ) cat("\nThe following methods are now defined:\n") ## Let's try to create generics for ( i in 1:length(f) ) { generic <- paste( "setGeneric(\"", f[i], "\", function(", paste(names(sig[[i]]),collapse=", "), ") standardGeneric(\"", f[i], "\"),where=where )", sep="") eval(parse(text=generic)) setMethod(f[i], sig[[i]], fns[[i]], where=where) if ( verbose ) showMethods(f[i]) } } ) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - setMethod( "setCMethod", signature(f="character", sig="character", body="character"), function(f, sig, body, includes="", otherdefs="", language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), where=topenv(.GlobalEnv), ...) setCMethod(f, list(sig), list(body), includes, otherdefs, language, verbose, convention, where=topenv(.GlobalEnv), ...) ) inline/R/cxxfunction.R0000644000175000017500000001116612113367321013346 0ustar00eddedd plugins <- new.env() plugins[["default"]] <- function( ){ includes = '#include #include #include ' list( includes = includes, body = function( x ) paste( x, '\nRf_warning("your C++ program does not return anything"); \n return R_NilValue ; ' ) ) } registerPlugin <- function( name, plugin ){ plugins[[ name ]] <- plugin } getPlugin <- function( name, ... ){ if( name %in% ls( plugins ) ){ plugins[[ name ]]( ... ) } else if( sprintf("package-%s", name) %in% search() || require( name, character.only = TRUE, quietly = TRUE) ){ plugin <- get( "inlineCxxPlugin" , asNamespace(name) ) if( is.null(plugin) ){ stop( sprintf( "package '%s' does not define an inline plugin", name ) ) } registerPlugin( name, plugin ) plugin( ... ) } else { stop( sprintf( "could not find plugin '%s'", name ) ) } } paste0 <- function(...) paste(..., sep="") addLineNumbers <- function( code ){ code <- strsplit( paste( code, collapse = "\n" ), "\n" )[[1]] sprintf( "%4d : %s", 1:length(code), code) } cxxfunction <- function ( sig = character(), body = character(), plugin = "default", includes = "", settings = getPlugin(plugin), ..., verbose = FALSE ){ f <- basename( tempfile( ) ) if( ! is.list( sig ) ){ sig <- list( sig ) names( sig ) <- f if( ! length( body ) ) body <- "" names( body ) <- f } if( length(sig) != length(body) ) stop("mismatch between the number of functions declared in 'sig' and the number of function bodies provided in 'body'") signature <- lapply( sig, function(x) { if( ! length(x) ){ "" } else { paste( sprintf( "SEXP %s", names(x) ), collapse = ", " ) } } ) decl <- lapply( 1:length(sig) , function(index) { sprintf( 'SEXP %s( %s) ;', names(signature)[index] , signature[[index]] ) } ) def <- lapply( 1:length(sig), function(index){ sprintf( ' SEXP %s( %s ){ %s } ', names(signature)[index], signature[[index]], if(is.null(settings$body)) body[[index]] else settings$body(body[[index]]) ) } ) settings_includes <- if( is.null( settings$includes ) ) "" else paste( settings$includes, collapse = "\n" ) code <- sprintf( ' // includes from the plugin %s // user includes %s // declarations extern "C" { %s } // definition %s ', settings_includes , paste( includes, collapse = "\n" ), paste( decl, collapse = "\n" ), paste( def, collapse = "\n") ) if( !is.null( env <- settings$env ) ){ do.call( Sys.setenv, env ) if( isTRUE(verbose) ){ cat( " >> setting environment variables: \n" ) writeLines( sprintf( "%s = %s", names(env), env ) ) } } LinkingTo <- settings$LinkingTo if( !is.null( LinkingTo ) ){ paths <- find.package(LinkingTo, quiet=TRUE) if( length( paths ) ){ flag <- paste( paste0( '-I"', paths, '/include"' ), collapse = " " ) Sys.setenv( CLINK_CPPFLAGS = flag ) if( isTRUE( verbose ) ){ cat( sprintf( "\n >> LinkingTo : %s\n", paste( LinkingTo, collapse = ", " ) ) ) cat( "CLINK_CPPFLAGS = ", flag, "\n\n" ) } } } if( isTRUE( verbose ) ){ writeLines( " >> Program source :\n" ) writeLines( addLineNumbers( code ) ) } language <- "C++" ## WRITE AND COMPILE THE CODE libLFile <- compileCode( f, code, language = language, verbose = verbose ) ## SET A FINALIZER TO PERFORM CLEANUP cleanup <- function(env) { if ( f %in% names(getLoadedDLLs()) ) dyn.unload(libLFile) unlink(libLFile) } reg.finalizer(environment(), cleanup, onexit=TRUE) ## Create new objects of class CFunc, each containing the code of ALL inline ## functions. This will be used to recompile the whole shared lib when needed res <- vector("list", length(sig)) names(res) <- names(sig) res <- new( "CFuncList", res ) DLL <- dyn.load( libLFile ) for( i in seq_along(sig) ){ res[[i]] <- new( "CFunc", code = code ) fn <- function(arg) { NULL } ## Modify the function formals to give the right argument list args <- formals(fn)[ rep(1, length(sig[[i]])) ] names(args) <- names(sig[[i]]) formals(fn) <- args ## create .Call function call that will be added to 'fn' body <- quote( .Call( EXTERNALNAME, ARG) )[ c(1:2, rep(3, length(sig[[i]]))) ] for ( j in seq(along = sig[[i]]) ) body[[j+2]] <- as.name(names(sig[[i]])[j]) body[[1L]] <- .Call body[[2L]] <- getNativeSymbolInfo( names(sig)[[i]], DLL )$address ## update the body of 'fn' body(fn) <- body ## set fn as THE function in CFunc of res[[i]] res[[i]]@.Data <- fn } ## clear the environment rm( j ) convention <- ".Call" if( identical( length(sig), 1L ) ) res[[1L]] else res } rcpp <- function(..., plugin="Rcpp") cxxfunction(..., plugin=plugin) inline/R/getDynLib.R0000644000175000017500000000114612032661337012660 0ustar00eddeddsetGeneric("getDynLib", function(x, ...) standardGeneric("getDynLib") ) setMethod( "getDynLib", signature( x = "character" ), function( x ){ dlls <- getLoadedDLLs() if( x %in% names( dlls ) ){ dlls[[ x ]] } else { stop( sprintf( "dll %s not loaded", x ) ) } } ) setMethod( "getDynLib", signature( x = "CFunc" ), function( x ){ env <- environment( x@.Data ) f <- get( "f", env ) dlls <- getLoadedDLLs() dll <- if( ! f %in% names(dlls) ){ dyn.load( get( "libLFile", env ) ) } else{ dlls[[ f ]] } dll } ) setMethod( "getDynLib", signature( x = "CFuncList" ), function(x) getDynLib( x[[1L]] ) ) inline/R/package.skeleton.R0000644000175000017500000001075212156057553014226 0ustar00eddedd setGeneric( "package.skeleton" ) setMethod( "package.skeleton", signature( name = "character", list = "CFuncList" ), function (name = "anRpackage", list = new( "CFuncList" ), environment = .GlobalEnv, path = ".", force = FALSE, code_files = character()) { env <- environment( list[[1]]@.Data ) clean.env <- new.env( parent = environment ) functions <- names( list ) for( i in seq_along(list) ){ f <- functions[i] call <- body( list[[i]]@.Data ) call[[1L]] <- as.name( env$convention ) call[[2L]] <- names( env$sig )[i] call[["PACKAGE"]] <- name fun <- list[[i]]@.Data body( fun ) <- call environment(fun) <- clean.env assign( f, fun, clean.env ) } message( ">> standard package.skeleton from utils" ) package.skeleton( name, functions , clean.env, path, force, code_files ) if( !file.exists( R <- file.path(name, "R") ) ){ dir.create( R ) con <- file( file.path( R, sprintf("%s.R", name) ), open = "w" ) for( i in seq_along(list) ){ fun <- functions[i] writeLines( sprintf( ' %s <- %s\n' , fun, paste( deparse(clean.env[[ fun ]] ), collapse = "\n" ) ), con ) } close( con ) message( ">> added R directory with function calling compiled code" ) } Rdfiles <- file.path( name, "man", sprintf( "%s.Rd", functions ) ) sapply( Rdfiles, function( Rdfile) { if( file.exists( Rdfile ) ){ content <- readLines( Rdfile ) content <- sub( "%% ~~function to do ... ~~", "insert here the title", content ) writeLines( content, Rdfile ) } message( ">> workaround for empty title in Rd file" ) } ) package.doc <- file.path( name, "man", sprintf("%s-package.Rd", name) ) if( file.exists( package.doc) ){ lines <- readLines( package.doc ) lines <- sub( "~~ simple examples of", "%% ~~ simple examples of", lines ) writeLines( lines, package.doc ) } dir.create( file.path( name, "src" ) ) message( ">> created src directory" ) NAMESPACE <- sprintf( ' useDynLib(%s) %s ', name, paste( sprintf( 'export("%s")', functions ), collapse = "\n" ) ) writeLines( NAMESPACE, file.path( name, "NAMESPACE" ) ) language <- env$language extension <- switch(language, "C++"=".cpp", C=".c", Fortran=".f", F95=".f95", ObjectiveC=".m", "ObjectiveC++"=".mm") cfile <- file.path( name, "src", sprintf( "%s%s", name, extension ) ) writeLines( list[[1]]@code, cfile ) message( ">> added compiled code in src directory" ) settings <- env$settings if( !is.null( settings ) ){ DESCRIPTION_file <- file.path( name, "DESCRIPTION" ) DESCRIPTION <- read.dcf( DESCRIPTION_file ) depends <- settings$Depends if( !is.null( depends ) ){ DESCRIPTION <- cbind( DESCRIPTION, "Depends" = paste( depends, collapse = ", ") ) } linkingTo <- settings$LinkingTo if( !is.null( linkingTo ) ){ DESCRIPTION <- cbind( DESCRIPTION, "LinkingTo" = paste( linkingTo, collapse = ", ") ) } write.dcf( DESCRIPTION, DESCRIPTION_file ) message( ">> updated DESCRIPTION file" ) Makevars <- settings$Makevars if( !is.null( Makevars ) ){ Makevars_file <- file.path( name, "src", "Makevars" ) writeLines( Makevars, Makevars_file ) message( ">> added Makevars ") } Makevars.win <- settings$Makevars.win if( !is.null( Makevars.win ) ){ Makevars.win_file <- file.path( name, "src", "Makevars.win" ) writeLines( Makevars.win, Makevars.win_file ) message( ">> added Makevars.win" ) } configure <- settings$configure if( ! is.null( configure ) ){ configure_file <- file.path(name, "configure" ) writeLines( configure, configure_file ) Sys.chmod(configure_file, "0755") message( ">> added configure" ) } configure.win <- settings$configure.win if( ! is.null( configure.win ) ){ configure_win_file <- file.path(name, "configure.win" ) writeLines( configure.win, configure_win_file ) message( ">> added configure.win" ) } Makevars.in <- settings$Makevars.in if( ! is.null( Makevars.in ) ){ Makevars_in_file <- file.path(name, "src", "Makevars.in" ) writeLines( Makevars.in, Makevars_in_file ) message( ">> added Makevars.in" ) } } invisible(NULL) } ) setMethod( "package.skeleton", signature( name = "character", list = "CFunc" ), function (name = "anRpackage", list = new( "CFunc" ), environment = .GlobalEnv, path = ".", force = FALSE, code_files = character() ) { funclist <- new( "CFuncList", base::list( fun = list ) ) package.skeleton( name = name, list = funclist, environment = environment, path = path , force = force, code_files = code_files ) } ) inline/inst/0000755000175000017500000000000012201150464011416 5ustar00eddeddinline/inst/NEWS.Rd0000644000175000017500000000557012201014231012457 0ustar00eddedd\name{NEWS} \title{News for Package 'inline'} \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} \section{Changes in inline version 0.3.13 (2013-08-08)}{ \itemize{ \item Applied contributed patch by Mikhail Umorin which corrects \code{cfunction()} in the case of a \code{list} of signature and body arguments. } } \section{Changes in inline version 0.3.12 (2013-06-12)}{ \itemize{ \item Align \code{package.skeleton} with the R-devel version of the function which no longer has a \code{NAMESPACE} argument. \item Remove copy of LGPL in source archive as \code{R CMD check} now complains about it. License status continues to be specified in file \code{DESCRIPTION}. } } \section{Changes in inline version 0.3.11 (2013-02-26)}{ \itemize{ \item Fix bug in \code{cfunction} for \code{.C} convention with raw vectors. \item Correct \code{cfunction} to use \code{.Platform$dynlib.ext} as the file extension for the library file (unless on Windows). \item Allow \code{rcpp} wrapper to pass another plugin (as eg RcppArmadillo) } } \section{Changes in inline version 0.3.10 (2012-10-03)}{ \itemize{ \item \code{getDynLib()} error message corrected as suggested by Yasir Suhail \item Added \code{rcpp()} wrapper for \code{cxxfunction()} which sets \code{plugin="Rcpp"} \item Converted NEWS to NEWS.Rd \item New maintainer, after having coordinated releases (along with Romain) since 0.3.5 in June 2010 } } \section{Changes in inline version 0.3.9 (2012-10-02)}{ \itemize{ \item Uncoordinating hijacking of package by CRAN maintainers with a single word change in cfunction.R to prevent an error under an unreleased version of R } } \section{Changes in inline version 0.3.8 (2010-12-07)}{ \itemize{ \item faster \code{cfunction} and \code{cxxfunction} by loading and resolving the routine at \dQuote{compile} time } } \section{Changes in inline version 0.3.7 (2010-11-02)}{ \itemize{ \item fix \code{package.skeleton} for use with just a single function } } \section{Changes in inline version 0.3.6 (2010-07-29)}{ \itemize{ \item compileCode now grabs the error message generated by the compiler and uses it in in the error message } } \section{Changes in inline version 0.3.5 (2010-06-02)}{ \itemize{ \item new R function \code{cxxfunction} to generate an R function with inlined C++ code using the \code{.Call} calling convention. The function was introduced to accomodate the needs of the Rcpp family of packages. \item new R functions \code{getPlugin} and \code{registerPlugin} to manage the plugin system of \code{cxxfunction}. \item The function \code{package.skeleton} (from utils) is made generic and a method is available to generate a package skeleton from a function generated by \code{cfunction} or \code{cxxfunction} } } inline/man/0000755000175000017500000000000012201014202011201 5ustar00eddeddinline/man/cfunction.Rd0000644000175000017500000002130612201014202013462 0ustar00eddedd\name{cfunction} \alias{cfunction} \alias{setCMethod} \concept{inline function call} \title{ Inline C, C++, Fortran function calls from R } \description{ Functionality to dynamically define R functions and S4 methods with in-lined C, C++ or Fortran code supporting .C and .Call calling conventions. } \usage{ cfunction(sig=character(), body=character(), includes=character(), otherdefs=character(), language=c("C++", "C", "Fortran", "F95", "ObjectiveC", "ObjectiveC++"), verbose=FALSE, convention=c(".Call", ".C", ".Fortran"), Rcpp=FALSE, cppargs=character(), cxxargs=character(), libargs=character()) ## S4 methods for signatures # f='character', sig='list', body='list' # f='character', sig='character', body='character' setCMethod(f, sig, body, ...) ## Further arguments: # setCMethod(f, sig, body, includes="", otherdefs="", cpp=TRUE, # verbose=FALSE, where=topenv(.GlobalEnv), ...) } \arguments{ \item{f}{A single character value if \code{sig} and \code{body} are character vectors or a character vector of the same length and the length of \code{sig} or \code{body} with the name(s) of methods to create.} \item{sig}{A match of formal argument names for the function with the character-string names of corresponding classes. Alternatively, a list of such character vectors. } \item{body}{ A character vector with C, C++ or Fortran code omitting function declaration (only the body, i.e. in case of C starting after the function opening curly bracket and ending before the closing curly bracket, brackets excluded). In case of \code{setCMethod} with signature \code{list} -- a list of such character vectors. } \item{includes}{ A character vector of additional includes and preprocessor statements etc that will be put between the R includes and the user function(s).} \item{otherdefs}{ A characted vector with the code for any further definitions of functions, classes, types, forward declarations, namespace usage clauses etc which is inserted between the includes and the declarations of the functions defined in \code{sig}.} \item{language}{ A character value that specifies the source language of the inline code. The possible values for \code{language} include all those supported by \code{R CMD SHLIB} on any platform, which are currently C, C++, Fortran, F95, ObjectiveC and ObjectiveC++; they may not all be supported on your platform. One can specify the language either in full as above, or using any of the following case insensitive shortened forms: \code{c, cpp, c++, f, f95, objc, objcpp, objc++}. Defaults to \code{C++}.} \item{verbose}{ If \code{TRUE} prints the compilation output, the source code of the resulting program and the definitions of all declared methods. If \code{FALSE}, the function is silent, but it prints compiler warning and error messages and the source code if compilation fails. } \item{convention}{ Which calling convention to use? See the Details section.} \item{Rcpp}{If \code{TRUE} adds inclusion of \code{Rcpp.h} to \code{includes}, also queries the \code{Rcpp} package about the location of header and library files and sets environment variables \code{PKG_CXXFLAGS} and \code{PKG_LIBS} accordingly so that the R / C++ interface provided by the \code{Rcpp} package can be used. Default value is \code{FALSE}.} \item{cppargs}{Optional character vector of tokens to be passed to the compiler via the \code{PKG_CPPFLAGS} environment variable. Elements should be fully formed as for example \code{c("-I/usr/local/lib/foo", "-DDEBUG")} and are passed along verbatim.} \item{cxxargs}{Optional character vector of tokens to be passed to the compiler via the \code{PKG_CXXFLAGS} environment variable. Elements should be fully formed as for example \code{c("-I/usr/local/lib/foo", "-DDEBUG")} and are passed along verbatim.} \item{libargs}{Optional character vector of tokens to be passed to the compiler via the \code{PKG_LIBS} environment variable. Elements should be fully formed as for example \code{c("-L/usr/local/lib/foo -lfoo", "--lpthread")} and are passed along verbatim.} \item{...}{ Reserved.} } \value{ If \code{sig} is a single character vector, \code{cfunction} returns a single \code{\link{function}}; if it is a list, it returns a list of functions. \code{setCMethod} declares new methods with given names and signatures and returns invisible \code{NULL}. } \details{ To declare multiple functions in the same library one can use \code{setCMethod} supplying lists of signatures and implementations. In this case, provide as many method names in \code{f} as you define methods. Avoid clashes when selecting names of the methods to declare, i.e. if you provide the same name several times you must ensure that signatures are different but can share the same generic! The source code in the \code{body} should not include the header or "front-matter" of the function or the close, e.g. in C or C++ it must start after the C-function opening curly bracket and end before the C-function closing curly bracket, brackets should not be included. The header will be automatically generated from the R-\code{signature} argument. Arguments will will carry the same name as used in the signature, so avoid variable names that are not legal in the target language (e.g. names with dots). C/C++: If \code{convention == ".Call"} (the default), the \code{\link{.Call}} mechanism is used and its result is returned directly as the result of the call of the generated function. As the last line of the generated C/C++ code a \code{return R_NilValue;} is added in this case and a warning is generated in case the user has forgotten to provide a return value. To suppress the warning and still return NULL, add \code{return R_NilValue;} explicitly. Special care is needed with types, memory allocation and protection -- exactly the same as if the code was not inline: see the Writing R Extension manual for information on \code{\link{.Call}}. If \code{convention == ".C"} or \code{convention == ".Fortran"}, the \code{\link{.C}} or \code{\link{.Fortran}} mechanism respectively is used, and the return value is a list containing all arguments. Attached R includes include \code{R.h} for \code{".C"}, and additionally \code{Rdefines.h} and \code{R_ext\\Error.h} for \code{".Call"}. } \seealso{ \code{ \link{Foreign} Function Interface }} \examples{ x <- as.numeric(1:10) n <- as.integer(10) \dontrun{ ## A simple Fortran example code <- " integer i do 1 i=1, n(1) 1 x(i) = x(i)**3 " cubefn <- cfunction(signature(n="integer", x="numeric"), code, convention=".Fortran") cubefn(n, x)$x } ## Use of .C convention with C code ## Defining two functions, one of which calls the other sigSq <- signature(n="integer", x="numeric") codeSq <- " for (int i=0; i < *n; i++) { x[i] = x[i]*x[i]; }" sigQd <- signature(n="integer", x="numeric") codeQd <- " squarefn(n, x); squarefn(n, x); " fns <- cfunction( list(squarefn=sigSq, quadfn=sigQd), list(codeSq, codeQd), convention=".C") squarefn <- fns[["squarefn"]] quadfn <- fns[["quadfn"]] squarefn(n, x)$x quadfn(n, x)$x ## Alternative declaration using 'setCMethod' setCMethod(c("squarefn", "quadfn"), list(sigSq, sigQd), list(codeSq, codeQd), convention=".C") squarefn(n, x)$x quadfn(n, x)$x ## Use of .Call convention with C code ## Multyplying each image in a stack with a 2D Gaussian at a given position code <- " SEXP res; int nprotect = 0, nx, ny, nz, x, y; PROTECT(res = Rf_duplicate(a)); nprotect++; nx = INTEGER(GET_DIM(a))[0]; ny = INTEGER(GET_DIM(a))[1]; nz = INTEGER(GET_DIM(a))[2]; double sigma2 = REAL(s)[0] * REAL(s)[0], d2 ; double cx = REAL(centre)[0], cy = REAL(centre)[1], *data, *rdata; for (int im = 0; im < nz; im++) { data = &(REAL(a)[im*nx*ny]); rdata = &(REAL(res)[im*nx*ny]); for (x = 0; x < nx; x++) for (y = 0; y < ny; y++) { d2 = (x-cx)*(x-cx) + (y-cy)*(y-cy); rdata[x + y*nx] = data[x + y*nx] * exp(-d2/sigma2); } } UNPROTECT(nprotect); return res; " funx <- cfunction(signature(a="array", s="numeric", centre="numeric"), code) x <- array(runif(50*50), c(50,50,1)) res <- funx(a=x, s=10, centre=c(25,15)) if (interactive()) image(res[,,1]) ## Same but done by registering an S4 method setCMethod("funy", signature(a="array", s="numeric", centre="numeric"), code, verbose=TRUE) res <- funy(x, 10, c(35,35)) if (interactive()) { x11(); image(res[,,1]) } } \author{ Oleg Sklyar, Duncan Murdoch, Mike Smith, Dirk Eddelbuettel } \keyword{file} inline/man/cxxfunction.Rd0000644000175000017500000000361412105500643014060 0ustar00eddedd\name{cxxfunction} \alias{cxxfunction} \alias{rcpp} \title{ inline C++ function } \description{ Functionality to dynamically define an R function with inlined C++ code using the \code{\link{.Call}} calling convention. The \code{rcpp()} wrapper sets the plugin to the \dQuote{Rcpp} value suitable for using \pkg{Rcpp}. } \usage{ cxxfunction(sig = character(), body = character(), plugin = "default", includes = "", settings = getPlugin(plugin), ..., verbose = FALSE) rcpp(..., plugin="Rcpp") } \arguments{ \item{sig}{Signature of the function. A named character vector} \item{body}{A character vector with C++ code to include in the body of the compiled C++ function} \item{plugin}{Name of the plugin to use. See \code{\link{getPlugin}} for details about plugins. } \item{includes}{User includes, inserted after the includes provided by the plugin. } \item{settings}{Result of the call to the plugin} \item{\dots}{Further arguments to the plugin} \item{verbose}{verbose output} } \value{ A function } \seealso{ \code{\link{cfunction}} } \examples{ \dontrun{ # default plugin fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ; ' ) fx( 2L, 5 ) # Rcpp plugin if( require( Rcpp ) ){ fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' return wrap( as(x) * as(y) ) ; ', plugin = "Rcpp" ) fx( 2L, 5 ) ## equivalent shorter form using rcpp() fx <- rcpp(signature(x = "integer", y = "numeric"), ' return wrap( as(x) * as(y) ) ; ') } # RcppArmadillo plugin if( require( RcppArmadillo ) ){ fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' int dim = as( x ) ; arma::mat z = as(y) * arma::eye( dim, dim ) ; return wrap( arma::accu(z) ) ; ', plugin = "RcppArmadillo" ) fx( 2L, 5 ) } } } \keyword{programming} \keyword{interface} inline/man/getDynLib.Rd0000644000175000017500000000241111401555112013362 0ustar00eddedd\name{getDynLib-methods} \docType{methods} \alias{getDynLib} \alias{getDynLib-methods} \alias{getDynLib,CFunc-method} \alias{getDynLib,character-method} \alias{getDynLib,CFuncList-method} \title{Retrieve the dynamic library (or DLL) associated with a package of a function generated by cfunction} \description{ The \code{getDynLib} function retrieves the dynamic library (or DLL) associated with a package or with a function generated by \code{\link{cfunction}} } \section{Methods}{ \describe{ \item{\code{signature(x = "CFunc")}}{Retrieves the dynamic library associated with the function generated by \code{\link{cfunction}}. The library is dynamically loaded if necessary. } \item{\code{signature(x = "CFuncList")}}{Retrieves the dynamic library associated with a set of functions generated by \code{\link{cfunction}}. The library is dynamically loaded if necessary. } \item{\code{signature(x = "character")}}{ Retrieves the dynamic library of the given name. This typically refers to package names, but can be any name of the list returned by \code{\link{getLoadedDLLs}} } }} \seealso{\code{\link{getLoadedDLLs}}, \code{\link{dyn.load}} } \examples{ \dontrun{ getDynLib( "base" ) f <- cfunction( signature() , "return R_NilValue ;" ) getDynLib( f ) }} \keyword{methods} inline/man/inline-package.Rd0000644000175000017500000000131412032656253014362 0ustar00eddedd\name{inline-package} \alias{inline-package} \alias{inline} \docType{package} \title{ Inline C, C++, Fortran function calls from R } \description{ Functionality to dynamically define R functions and S4 methods with in-lined C, C++ or Fortran code supporting \code{\link{.C}} and \code{\link{.Call}} calling conventions. } \details{ \tabular{ll}{ Package: \tab inline\cr Type: \tab Package\cr Version: \tab 0.3.8\cr Date: \tab 2010-12-07\cr License: \tab LGPL\cr LazyLoad: \tab yes\cr } } \seealso{ \code{\link{cfunction}}, \code{\link{cxxfunction}} } \author{ Oleg Sklyar, Duncan Murdoch, Mike Smith, Dirk Eddelbuettel, Romain Francois Maintainer: Oleg Sklyar } \keyword{ package } inline/man/internals.Rd0000644000175000017500000000060111400243654013503 0ustar00eddedd\name{internals} \alias{internals} \alias{setCMethod,character,list,list-method} \alias{setCMethod,character,character,character-method} \title{ Internals } \description{ Aliases required for 'R CMD check' but those noone will ever search for. Here to prevent the mess of the index. The corresponding items have help aliases without method signature! } \keyword{internal} inline/man/package.skeleton.Rd0000644000175000017500000000227211401555112014724 0ustar00eddedd\name{package.skeleton-methods} \docType{methods} \alias{package.skeleton-methods} \alias{package.skeleton,ANY,ANY-method} \alias{package.skeleton,character,CFunc-method} \alias{package.skeleton,character,CFuncList-method} \title{Generate the skeleton of a package} \description{ Generate the skeleton of a package } \section{Methods}{ \describe{ \item{\code{signature(name = "ANY", list = "ANY")}}{ Standard method. See \code{\link[utils]{package.skeleton}} } \item{\code{signature(name = "character", list = "CFunc")}}{ Method for a single generated by \code{\link{cfunction}} or \code{\link{cxxfunction}} } \item{\code{signature(name = "character", list = "CFuncList")}}{ Method for a set functions generated by \code{\link{cfunction}} or \code{\link{cxxfunction}} } }} \examples{ \dontrun{ fx <- cxxfunction( signature(x = "integer", y = "numeric" ) , ' return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ; ' ) package.skeleton( "foo", fx ) functions <- cxxfunction( list( ff = signature(), gg = signature( x = "integer", y = "numeric" ) ), c( "return R_NilValue ;", "return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ;") ) package.skeleton( "foobar", functions ) } } \keyword{methods} inline/man/plugins.Rd0000644000175000017500000000360111400243654013170 0ustar00eddedd\name{plugins} \alias{getPlugin} \alias{registerPlugin} \title{ Plugin system for cxxfunction } \description{ \code{\link{cxxfunction}} uses a plugin system to assembly the code that it compiles. These functions allow to register and get plugins by their name. } \usage{ getPlugin(name, ...) registerPlugin(name, plugin) } \arguments{ \item{name}{name of the plugin. } \item{\dots}{Further argments to pass to the plugin. } \item{plugin}{plugin function. } } \details{ plugins are functions that return a list with : \describe{ \item{includes}{mandatory. it is included at the top of the compiled file by \code{\link{cxxfunction}} } \item{body}{optional. a function that takes one argument (the body of the c++ function) and returned a modified version of the body. The "Rcpp" plugin uses this to surround the code with the \code{BEGIN_RCPP} and \code{END_RCPP} macros } \item{LinkingTo}{optional. character vector containing the list of packages that the code needs to link to. This adds the include path of the given packages. The "Rcpp" and "RcppArmadillo" plugins use this. } \item{env}{optional. named list of environment variables. For example, the "Rcpp" plugin uses this to add Rcpp user library to the \code{PKG_LIBS} environment variable. } } plugins can be manually registered using the \code{registerPlugin} function. Alternatively, a package may supply an inline plugin implicitely by defining a function called \code{inlineCxxPlugin}, which does not necessarily need to be exported from the namespace of the package. Known packages implementing this scheme include \code{Rcpp} and \code{RcppArmadillo}. } \value{ \code{getPlugin} retrieves the plugin and invokes it with the \dots arguments \code{registerPlugin} does not return anything. } \seealso{ \code{\link{cxxfunction}} } \examples{ \dontrun{ getPlugin( "Rcpp" ) } } \keyword{programming} \keyword{interface}