inline/0000755000176200001440000000000013277544723011546 5ustar liggesusersinline/inst/0000755000176200001440000000000013277536337012525 5ustar liggesusersinline/inst/NEWS.Rd0000644000176200001440000001012113277536337013563 0ustar liggesusers\name{NEWS} \title{News for Package \pkg{inline}} \newcommand{\ghpr}{\href{https://github.com/eddelbuettel/inline/pull/#1}{##1}} \newcommand{\ghit}{\href{https://github.com/eddelbuettel/inline/issues/#1}{##1}} \section{Changes in inline version 0.3.15 (2018-05-18)}{ \itemize{ \item Correct \code{requireNamespace()} call thanks (Alexander Grueneberg in \ghpr{5}). \item Small simplification to \code{.travis.yml}; also switch to https. \item Use \code{seq_along} instead of \code{seq(along=...)} (Watal M. Iwasaki) in \ghpr{6}). \item Update package manual page using references to \code{DESCRIPTION} file [CRAN request]. \item Minor packaging updates. } } \section{Changes in inline version 0.3.14 (2015-04-11)}{ \itemize{ \item Removed call to \code{Rcpp::RcppLdFlags()} which is no longer needed \item With move of repository to GitHub, added a \code{.travis.yml} file and corresponding entry in \code{.Rbuildignore} \item Replaced calls to \code{require()} with calls to \code{requireNamespace()}; also updated one call \item Much improved support for Fortran and Fortran95 thanks to Karline Soetaert who became a package co-author \item New helper functions \code{writeDynLib} and \code{readDynLib} as well as new methods \code{print} and \code{code} (also by Karline) } } \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/NAMESPACE0000644000176200001440000000040112512213436012741 0ustar liggesusersimport("methods") importFrom("utils", "package.skeleton") export( "cfunction", "cxxfunction", "getPlugin", "registerPlugin", "rcpp" ) exportMethods( "setCMethod", "getDynLib", "package.skeleton", "print", "code" ) inline/R/0000755000176200001440000000000012746363317011745 5ustar liggesusersinline/R/getDynLib.R0000644000176200001440000000114612377726054013754 0ustar liggesuserssetGeneric("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/utilities.R0000644000176200001440000000647112512213336014075 0ustar liggesusers## --------------------------------------------------------------------------- # saving and loading CFunc objects (called write and read as it needs to # be assigned. writeDynLib <- function(x, file) { DLL <- getDynLib(x) if (is.null(DLL)) stop ("'x' DLL not loaded") DLLname <- DLL[["path"]] if (!file.exists(DLLname)) stop ("'x' does not point to an existing DLL") # correct extension of filename (dll, so) dname <- dirname(file) bname <- unlist(strsplit(basename(file), ".", fixed = TRUE))[1] extension <- unlist(strsplit(basename(DLLname), ".", fixed = TRUE))[2] file <- paste(dname,bname, extension, sep = ".") try(dyn.unload(file), silent = TRUE) file.copy(from = DLLname, to = file, overwrite = TRUE) # accessory file with compiled code information (DLL name has changed) fileCF <- paste(dname,"/",bname, ".Cfunc", sep = "") attributes(x)$DLL <- file # names of functions in compiled code if (class(x) == "CFunc") attributes(x)$fname <- DLL[["name"]] else attributes(x)$fname <- names(x) save(file = fileCF, x) } ## --------------------------------------------------------------------------- readDynLib <- function(file) { # open all the required files extension <- unlist(strsplit(basename(file), ".", fixed = TRUE))[2] if (is.na(extension)) { extension <- "CFunc" file <- paste(file, extension, sep = ".") } if (extension != "CFunc") stop ("'file' should point to a CFunc object, extension '.CFunc'") if (!file.exists(file)) stop ("'file' does not exist") CF <- get(load(file = file)) attrs <- attributes(CF) DLLname <- attrs$DLL if (!file.exists(DLLname)) stop ("'file' does not point to valid CFunc object: DLL ", DLLname, " does not exist") # cleanup <- function(env) { # unlink(DLLname) # } # reg.finalizer(environment(), cleanup, onexit = TRUE) # load routines in DLL DLL <- dyn.load(DLLname) fn <- attributes(CF)$fname if (class(CF) == "CFunc") { CFi <- CF code <- CFi@code body(CFi)[[2]] <- getNativeSymbolInfo(fn, DLL)$address CF@.Data <- CFi } else for (i in 1:length(CF)) { CFi <- CF[[i]] code <- CFi@code body(CFi)[[2]] <- getNativeSymbolInfo(fn[i], DLL)$address CF[[i]]@.Data <- CFi } attributes(CF) <- attrs return(CF) } setGeneric("code", function(x, ...) standardGeneric("code") ) setMethod( "code", signature( x = "character" ), function( x, linenumbers = TRUE ){ lines <- strsplit(x, "\n") if (linenumbers) for (i in 1:length(lines[[1]])) cat(format(i, width = 3), ": ", lines[[1]][i], "\n", sep = "") else for (i in 1:length(lines[[1]])) cat(lines[[1]][i], "\n", sep = "") } ) setMethod( "code", signature( x = "CFunc" ), function( x, linenumbers = TRUE ) code (x@code, linenumbers)) setMethod( "code", signature( x = "CFuncList" ), function(x, linenumbers = TRUE ) code( x[[1L]], linenumbers ) ) ## Printing methods setMethod( "print", signature( x = "CFunc" ), function( x ){ cat("An object of class 'CFunc'\n") Dat <- x@.Data print(Dat) cat("code:\n") code(x) } ) setMethod( "print", signature( x = "CFuncList" ), function(x) { cat("An object of class 'CFuncList'\n") for (i in 1:length(x)) { print(names(x)[i]) print(x[[i]]@.Data ) cat("\n") } cat("code:\n") code(x) } ) inline/R/package.skeleton.R0000644000176200001440000001075212377726054015314 0ustar liggesusers 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/R/cxxfunction.R0000644000176200001440000001114612746363317014443 0ustar liggesusers 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() || requireNamespace( name, 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/cmethods.R0000644000176200001440000000347012377726054013703 0ustar liggesusers# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 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/cfunction.R0000644000176200001440000003204412746363317014063 0ustar liggesusers# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## 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(), dim = NULL, implicit = NULL, module = NULL) { if (missing (convention) & !missing(language)) convention <- switch (EXPR = language, "Fortran" = ".Fortran", "F95" = ".Fortran", ".C" = ".C", ObjectiveC = ".Call", "ObjectiveC++" = ".Call", "C++" = ".Call") 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 (is.null(dim)) dim <- as.list(rep("(*)", length(sig))) else { # this assumes fortran style if (!is.list(dim)) dim <- list(dim) if (length(dim) != length(sig)) stop("mismatch between the number of functions declared in 'sig' and the number of dimensions declared in 'dim'") } if (Rcpp) { if (!requireNamespace("Rcpp", quietly=TRUE)) stop("Rcpp cannot be loaded, install it or use the default Rcpp=FALSE", call.=FALSE) cxxargs <- c(Rcpp:::RcppCxxFlags(), cxxargs) # 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 { # old-style fortran requires 6 columns not used lead <- ifelse (language == "Fortran", " ","") 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(lead, decls, " ", names(sig[[i]]), dim[[i]], sep="", collapse="\n") funCsig <- paste(names(sig[[i]]), collapse=", ") } else { decls <- "" funCsig <- "" } funCsig <- paste(lead,"SUBROUTINE", names(sig)[i], "(", funCsig, ")\n", sep=" ") ## old-style FORTRAN line length restricted to 72 characters if (language == "Fortran") { if ((cl <- nchar(funCsig)) >= 72) { fstring <- substr(funCsig, 72, cl) funCsig <- substr(funCsig, 1, 71) while ((cf <- nchar(fstring)) > 66) { funCsig <- paste(funCsig, "\n &", substr(fstring, 1, 66), sep = "") fstring <- substr(fstring, 67, cf) } if (cf > 0) funCsig <- paste(funCsig, "\n &", fstring, sep = "") funCsig <- paste(funCsig, "\n") } } ## IMPLICIT statement and module use if (is.character(module)) funCsig <- paste(funCsig, lead, "USE ", module, "\n", sep = "") if (is.character(implicit)) funCsig <- paste(funCsig, lead, "IMPLICIT ", implicit, "\n", sep = "") ## OPEN function code <- paste( code, funCsig, decls, "\n", collapse="\n", sep="") ## add code, split lines code <- paste( code, paste(body[[i]], collapse="\n"), sep="") ## CLOSE function code <- paste( code, "\n", lead, "RETURN\n", lead, "END\n\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/README.md0000644000176200001440000000125312377762570013030 0ustar liggesusers## Inline C, C++ or Fortran calls in R [![Build Status](https://travis-ci.org/eddelbuettel/inline.png)](https://travis-ci.org/eddelbuettel/inline) The inline package provides functionality to dynamically define R functions (and corresponding S4 objects) from in-line C, C++ or Fortran code. It supports both the `.C` and `.Call` calling conventions. ## History The package was originally written while Oleg Sklyar was at [EMBL-EBI](http://www.ebi.ac.uk/). It was later extended by Dirk Eddelbuettel and Romain Francois extended for use by [Rcpp](http://dirk.eddelbuettel.com/code/rcpp.html). ## Authors Oleg Sklyar, Dirk Eddelbuettel, Romain Francois ## License LGPL (>= 2) inline/MD50000644000176200001440000000166513277544723012066 0ustar liggesusers031e12db6337df75e0ecd4ae8f99584d *DESCRIPTION 95ca9be045875c664e131c24a67c6d1a *NAMESPACE ba41aceba4a4eaa576d31c66a8716539 *R/cfunction.R 3661ee24e0f177e278d23dc97797e056 *R/cmethods.R ab9db57362e717900c85751f401727dd *R/cxxfunction.R 7e32cd42ac56d4e281a1fe82b38738a7 *R/getDynLib.R b060d5e5093bf71dd36ba4ca26001cac *R/package.skeleton.R 0ff2d922761c7431a93e590fb88ac727 *R/utilities.R a8a2ee026398b29ee33954f3ff7dbc7e *README.md c12101ec3fcda9f9c9fc7a40ad5b4f2b *build/partial.rdb 013b6e1647bab5b96caff77c865efbcb *inst/NEWS.Rd d208cc9df3d3ada1ea8e854868e3c814 *man/cfunction.Rd 601bf59c3a06707ae4084c79f9b49aad *man/cxxfunction.Rd 18b89221354bc68a777c5ea418e6efbe *man/getDynLib.Rd d29d73247a35885fa13c0fa020866986 *man/inline-package.Rd c0c301365881f1f019e9ecae2df2a062 *man/internals.Rd 062a91de3b64623d6a67ef6efc1e5103 *man/package.skeleton.Rd 04a5e1e601e5da5565578ae818a848f6 *man/plugins.Rd 78c7e87d5955074e35908b161a7ea90c *man/utilities.Rd inline/build/0000755000176200001440000000000013277536462012646 5ustar liggesusersinline/build/partial.rdb0000644000176200001440000000473613277536462015005 0ustar liggesusersr"%ʲ;MD6rBD֊eG'ARB,.Xk?W;<8X,hDdQsRee*İp;݆tCR75ءQF$k̝ИY5/q-6e$yr,UI$&o_$tLW|;U(lVL1wpĶmuDiL{API#$rQ8uW5t& '\ޥ ^!G.~fOUWӘdX o yw(GLݼ'jMAQLMlnZ, Ǔ f[R6,FVvGe〦L>@S`5#HdeSx.7Q{ĵ]߰k$A.,/?ضn׬a~sd޷R^a+ TOst EI)#e/P( a>Mrq ]SM =5e^˒l8q)!e'NxN1^^N 8p <þAH1+aߗ)# bά8%X]rt!,Nw|A]g}dyf.>q+CMi]<ϐJ?3qOӐ".NRnҬeQ:h\\ +-L#r{ib&@pQ #,>O }zc p yӗ$\Nnl$s9xҳij銹f'SXmh=DÜ>,Q r /!ɳ ˜tRW(dzU-Ã} ˜6sHggҬɋb?/a{f.Ɏg >7OXU"[e_ji] PD%h5nYK<<7.[,F{OQi11rPMt}`uqFŪ,ivm֫dkDemƙP].-~"yYzUdgZ]GwĿ&PNG1i?y?|C; kšAiS|0-ی|mk<djzZD9?G6dݟ9jM!gbfy9e.Ȱ`d 7sv$C +6 nf%EuYv\ۊ$)6&E柑 ri-ĒbxdF]'6Mll*fHх5oy:nuj, }1`dA/~w(akJ/F)Fd}썣#ؗ,T0U 12r& x=.⅓%n>~]BL>KƵ@ p-LFCҠ?vmE)ѣ_?y#?֔8 9+? P" V5:inline/DESCRIPTION0000644000176200001440000000141213277544723013252 0ustar liggesusersPackage: inline Version: 0.3.15 Date: 2018-05-18 Title: Functions to Inline C, C++, Fortran Function Calls from R Author: Oleg Sklyar, Duncan Murdoch, Mike Smith, Dirk Eddelbuettel, Romain Francois, Karline Soetaert Maintainer: Dirk Eddelbuettel Depends: R (>= 2.4.0) Imports: methods Suggests: Rcpp (>= 0.11.0) Description: Functionality to dynamically define R functions and S4 methods with 'inlined' C, C++ or Fortran code supporting the .C and .Call calling conventions. License: LGPL Copyright: Oleg Sklyar, 2005-2010 and other authors per their commits LazyLoad: yes BugReports: https://github.com/eddelbuettel/inline/issues NeedsCompilation: no Packaged: 2018-05-18 11:46:58.172731 UTC; edd Repository: CRAN Date/Publication: 2018-05-18 12:40:51 UTC inline/man/0000755000176200001440000000000013277102277012313 5ustar liggesusersinline/man/plugins.Rd0000644000176200001440000000360112377726054014270 0ustar liggesusers\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} inline/man/inline-package.Rd0000644000176200001440000000046713277102263015453 0ustar liggesusers\name{inline-package} \alias{inline-package} \alias{inline} \docType{package} \title{\packageTitle{inline}} \description{\packageDescription{inline}} \seealso{\code{\link{cfunction}}, \code{\link{cxxfunction}}} \author{\packageAuthor{inline}} \section{Maintainer}{\packageMaintainer{inline}} \keyword{package} inline/man/utilities.Rd0000644000176200001440000000567612512213336014621 0ustar liggesusers\name{utilities} \alias{utilities} \alias{writeDynLib} \alias{readDynLib} \alias{print,CFunc-method} \alias{print,CFuncList-method} \alias{code} \alias{code-methods} \alias{code,character-method} \alias{code,CFunc-method} \alias{code,CFuncList-method} \title{ printing, reading and writing CFunc objects } \description{ \code{writeDynLib} saves the DLL and the CFunc or CFuncList object as generated by \link{cfunction}; \code{readDynLib} loads it. The \code{print} and \code{code} methods respectively print the entire object or the code parts. } \usage{ writeDynLib(x, file) readDynLib(file) } \section{Methods}{ \itemize{ \item Method \code{print(x, ...)} prints the entire object \code{x} \describe{ \item{\code{signature(x = "CFunc")}}{Prints the CFunc object generated by \code{\link{cfunction}}, including the code that generated it. } \item{\code{signature(x = "CFuncList")}}{Print all CFunc objects generated by \code{\link{cfunction}}, including the code that generated them. } } \item Method \code{code(x, linenumbers = TRUE, ...)} prints the code only \describe{ \item{\code{signature(x)}}{The \code{CFunc} or \code{CFuncList} object as generated by \code{\link{cfunction}}. } \item{\code{linenumbers}}{If \code{TRUE} all code lines will be numbered. } } } } \arguments{ \item{x}{A \code{CFunc} or \code{CFuncList} object as created by \code{\link{cfunction}} to be saved.} \item{file}{base name of the file to write the object to or to read from. Two files will be saved, one for the shared object or DLL (extension \code{so} or \code{DLL}) and one that holds the \code{CFunc} or \code{CFuncList} specification, without the function address (extension \code{CFunc}).} } \value{ Function \code{readDynLib} returns a \code{CFunc} or \code{CFuncList} object. } \details{ Both the CFunc or CFuncList object and the shared object or DLL are saved, in two files; the first has extension \code{CFunc}; the second \code{so} or \code{DLL}, depending on the operating system used. When reading, both files are loaded, and the compiled function address added to the object. } \note{ \itemize{ \item The code of a \code{CFunc} or \code{CFuncList} object \code{x} can be extracted (rather than printed), using: \code{x@code}. \item To write the code to a file (here called \code{"fn"}), without the new-line character \code{"\n"}: \code{write (strsplit(x, "\n")[[1]], file = "fn")} } } \seealso{ \code{ \link{getDynLib} }} \examples{ x <- as.numeric(1:10) n <- as.integer(10) 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") code(cubefn) cubefn(n, x)$x \dontrun{ fname <- tempfile() writeDynLib(cubefn, file = fname) # load and assign different name to object cfn <- readDynLib(fname) print(cfn) cfn(2, 1:2) } } \author{ Karline Soetaert } \keyword{file} inline/man/getDynLib.Rd0000644000176200001440000000241112377726054014466 0ustar liggesusers\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/cxxfunction.Rd0000644000176200001440000000361412377726054015163 0ustar liggesusers\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/internals.Rd0000644000176200001440000000060212512213336014565 0ustar liggesusers\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 no-one 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.Rd0000644000176200001440000000227212377726054016030 0ustar liggesusers\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/cfunction.Rd0000644000176200001440000002516712512213336014573 0ustar liggesusers\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(), dim=NULL, implicit=NULL, module=NULL) ## 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{dim}{Optional character vector defining the dimensionality of the function arguments. Of same length as \code{sig}. Fortran or F95 only.} \item{implicit}{A character vector defining the implicit declaration in Fortran or F95; the default is to use the implicit typing rules for Fortran, which is \code{integer} for names starting with the letters \code{I} through \code{N}, and \code{real} for names beginning with any other letter. As \code{R} passes double precision, this is not the best choice. Safest is to choose \code{implicit = "none"} which will require all names in the subroutine to be explicitly declared.} \item{module}{Name(s) of any modules to be used in the \code{Fortran} or \code{F95} subroutine.} \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 - n and x: assumed-size vector 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") print(cubefn) cubefn(n, x)$x ## Same Fortran example - now n is one number code2 <- " integer i do 1 i=1, n 1 x(i) = x(i)**3 " cubefn2 <- cfunction(signature(n="integer", x="numeric"), implicit = "none", dim = c("", "(*)"), code2, convention=".Fortran") cubefn2(n, x)$x ## Same in F95, now x is fixed-size vector (length = n) code3 <- "x = x*x*x" cubefn3 <- cfunction(sig = signature(n="integer", x="numeric"), implicit = "none", dim = c("", "(n)"), code3, language="F95") cubefn3(20, 1:20) print(cubefn3) ## Same example in C code4 <- " int i; for (i = 0; i < *n; i++) x[i] = x[i]*x[i]*x[i]; " cubefn4 <- cfunction(signature(n="integer", x="numeric"), code4, language = "C", convention = ".C") cubefn4(20, 1:20) } ## use of a module in F95 modct <- "module modcts double precision, parameter :: pi = 3.14159265358979 double precision, parameter :: e = 2.71828182845905 end" getconstants <- "x(1) = pi x(2) = e" cgetcts <- cfunction(getconstants, module = "modcts", implicit = "none", includes = modct, sig = c(x = "double"), dim = c("(2)"), language = "F95") cgetcts(x = 1:2) print(cgetcts) ## 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}