├── .Rbuildignore ├── .github └── workflows │ └── build.yml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── check.R ├── cppXPtr.R ├── print.R └── regex.R ├── README.Rmd ├── README.md ├── RcppXPtr.Rproj ├── cran-comments.md ├── man ├── checkXPtr.Rd └── cppXPtr.Rd ├── tests ├── testthat.R └── testthat │ ├── test-check.R │ └── test-regex.R └── working_dir ├── core.cpp └── main.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^CRAN-RELEASE$ 2 | ^.*\.Rproj$ 3 | ^\.Rproj\.user$ 4 | ^\.travis\.yml$ 5 | ^_pkgdown\.yml$ 6 | ^README\.Rmd$ 7 | ^README-.*\.png$ 8 | ^cran-comments\.md$ 9 | ^.*\.gcda$ 10 | ^.*\.gcno$ 11 | ^.*\.gcov$ 12 | working_dir 13 | .gitmodules 14 | .gitignore 15 | .git 16 | .lintr 17 | ^docs$ 18 | TODO 19 | ^CRAN-SUBMISSION$ 20 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | on: [push, pull_request] 3 | 4 | jobs: 5 | build: 6 | if: ${{ !contains(github.event.head_commit.message, '[ci skip]') }} 7 | runs-on: ${{ matrix.config.os }} 8 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 9 | 10 | strategy: 11 | fail-fast: false 12 | matrix: 13 | config: 14 | - {os: macOS-latest, r: 'release'} 15 | - {os: windows-latest, r: 'release'} 16 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 17 | - {os: ubuntu-latest, r: 'release', covr: 'yes'} 18 | - {os: ubuntu-latest, r: 'oldrel'} 19 | 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | R_KEEP_PKG_SOURCE: yes 23 | _R_CHECK_CRAN_INCOMING_REMOTE_: false 24 | 25 | steps: 26 | - uses: actions/checkout@v2 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | r-version: ${{ matrix.config.r }} 30 | http-user-agent: ${{ matrix.config.http-user-agent }} 31 | use-public-rspm: true 32 | - uses: r-lib/actions/setup-r-dependencies@v2 33 | with: 34 | extra-packages: rcmdcheck, covr 35 | - uses: r-lib/actions/setup-pandoc@v2 36 | 37 | - name: Check 38 | run: | 39 | rcmdcheck::rcmdcheck(args=c("--no-manual", "--as-cran"), 40 | error_on="warning", check_dir="check") 41 | shell: Rscript {0} 42 | 43 | - name: Upload check results 44 | if: ${{ failure() }} 45 | uses: actions/upload-artifact@master 46 | with: 47 | name: ${{ matrix.config.os }}-r${{ matrix.config.r }}-results 48 | path: check 49 | 50 | - name: Test coverage 51 | if: ${{ success() && matrix.config.covr == 'yes' }} 52 | run: covr::codecov() 53 | shell: Rscript {0} 54 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | 5 | # Compiled Object files 6 | *.slo 7 | *.lo 8 | *.o 9 | *.obj 10 | *.gcda 11 | *.gcno 12 | *.gcov 13 | # Precompiled Headers 14 | *.gch 15 | *.pch 16 | # Compiled Dynamic libraries 17 | *.so 18 | *.dylib 19 | *.dll 20 | # Fortran module files 21 | *.mod 22 | # Compiled Static libraries 23 | *.lai 24 | *.la 25 | *.a 26 | *.lib 27 | # Executables 28 | *.exe 29 | *.out 30 | *.app 31 | # OSX-specific 32 | .DS_Store 33 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: RcppXPtrUtils 2 | Type: Package 3 | Title: XPtr Add-Ons for 'Rcpp' 4 | Version: 0.1.2.1 5 | Authors@R: c( 6 | person("Iñaki", "Ucar", email="iucar@fedoraproject.org", 7 | role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550"))) 8 | Description: Provides the means to compile user-supplied C++ functions with 9 | 'Rcpp' and retrieve an 'XPtr' that can be passed to other C++ components. 10 | License: MIT + file LICENSE 11 | Encoding: UTF-8 12 | URL: https://github.com/Enchufa2/RcppXPtrUtils 13 | BugReports: https://github.com/Enchufa2/RcppXPtrUtils/issues 14 | Depends: R (>= 3.0.0) 15 | Imports: Rcpp 16 | Suggests: inline, testthat 17 | RoxygenNote: 7.3.2 18 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2017-2022 2 | COPYRIGHT HOLDER: Iñaki Ucar 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,XPtr) 4 | export(checkXPtr) 5 | export(cppXPtr) 6 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # RcppXPtrUtils devel 2 | 3 | - Fix cross-references in documentation (#3). 4 | 5 | # RcppXPtrUtils 0.1.2 6 | 7 | - Fix example. 8 | 9 | # RcppXPtrUtils 0.1.1 10 | 11 | - Fix error messages (#2). 12 | -------------------------------------------------------------------------------- /R/check.R: -------------------------------------------------------------------------------- 1 | #' Check an \code{XPtr}'s Signature 2 | #' 3 | #' Check the signature (i.e., arguments and return type) of the output of 4 | #' \code{\link{cppXPtr}}, which is an external pointer wrapped in an object of 5 | #' class \code{XPtr}. If the user-supplied C++ function does not match the 6 | #' signature, the wrapper throws an informative error. 7 | #' 8 | #' @param ptr an object of class \code{XPtr} compiled with \code{\link{cppXPtr}}. 9 | #' @param type the return type. 10 | #' @param args a list of argument types. 11 | #' @param call. logical, indicating if the call should become part of the error message. 12 | #' 13 | #' @seealso \code{\link{cppXPtr}} 14 | #' @examples 15 | #' \donttest{ 16 | #' # takes time to compile 17 | #' ptr <- cppXPtr("double foo(int a, double b) { return a + b; }") 18 | #' checkXPtr(ptr, "double", c("int", "double")) # returns silently 19 | #' try(checkXPtr(ptr, "int", c("double", "std::string"))) # throws error 20 | #' } 21 | #' @export 22 | checkXPtr <- function(ptr, type, args = character(), call. = TRUE) { 23 | stopifnot(inherits(ptr, "XPtr")) 24 | 25 | .type. <- attr(ptr, "type") 26 | .args. <- sapply(attr(ptr, "args"), .type, USE.NAMES=FALSE) 27 | msg <- character() 28 | 29 | if (type != .type.) 30 | msg <- paste(c( 31 | msg, paste0(" Wrong return type '", type, "', should be '", .type., "'.") 32 | ), collapse = "\n") 33 | 34 | if (length(args) != length(.args.)) 35 | msg <- paste(c( 36 | msg, paste0(" Wrong number of arguments, should be ", length(.args.), "'.") 37 | ), collapse = "\n") 38 | else { 39 | for (i in which(!(args == .args.))) 40 | msg <- paste(c( 41 | msg, paste0(" Wrong argument type '", args[[i]], "', should be '", .args.[[i]], "'.") 42 | ), collapse = "\n") 43 | } 44 | 45 | if (length(msg)) 46 | stop("Bad XPtr signature:\n", msg, call.=call.) 47 | } 48 | -------------------------------------------------------------------------------- /R/cppXPtr.R: -------------------------------------------------------------------------------- 1 | #' Define an \code{XPtr} with a C++ Implementation 2 | #' 3 | #' Dynamically define an \code{XPtr} with C++ source code. Compiles and links a shared 4 | #' library with bindings to the C++ function using \code{\link[Rcpp]{cppFunction}}, 5 | #' then returns an \code{XPtr} that points to the function and can be used to be 6 | #' plugged into another C++ backend. 7 | #' 8 | #' @inheritParams Rcpp::cppFunction 9 | #' @return An object of class \code{XPtr} that points to the compiled function. 10 | #' 11 | #' @seealso \code{\link[Rcpp]{cppFunction}}, \code{\link{checkXPtr}} 12 | #' @examples 13 | #' \donttest{ 14 | #' # takes time to compile 15 | #' ptr <- cppXPtr("double foo(int a, double b) { return a + b; }") 16 | #' class(ptr) 17 | #' print(ptr) 18 | #' } 19 | #' @export 20 | cppXPtr <- function(code, 21 | depends = character(), 22 | plugins = character(), 23 | includes = character(), 24 | rebuild = FALSE, 25 | cacheDir = getOption("rcpp.cache.dir", tempdir()), 26 | showOutput = verbose, 27 | verbose = getOption("verbose")) 28 | { 29 | stopifnot(isFunction(code)) 30 | 31 | # append a getter 32 | code <- sanitize_amp(code) 33 | wrapped_code <- paste(c( 34 | "SEXP getXPtr();", 35 | code, 36 | "SEXP getXPtr() {", 37 | paste(" typedef", .type(code), "(*funcPtr)(", .args(code), ");"), 38 | paste(" return XPtr(new funcPtr(&", .fname(code), "));"), 39 | "}"), collapse="\n") 40 | 41 | # source cpp into a controlled environment 42 | env <- new.env() 43 | Rcpp::cppFunction(wrapped_code, depends, plugins, includes, env, 44 | rebuild, cacheDir, showOutput, verbose) 45 | 46 | # return XPtr 47 | ptr <- env$getXPtr() 48 | attributes(ptr) <- list( 49 | class = "XPtr", 50 | type = .type(code), 51 | fname = .fname(code), 52 | args = .args(code, split=TRUE) 53 | ) 54 | ptr 55 | } 56 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.XPtr <- function(x, ...) { 3 | attrs <- attributes(x) 4 | cat("'", attrs[["type"]], " ", attrs[["fname"]], 5 | "(", paste(attrs[["args"]], collapse=", "), ")' ", sep="") 6 | attributes(x) <- NULL 7 | print(x) 8 | attributes(x) <- attrs 9 | invisible(x) 10 | } 11 | -------------------------------------------------------------------------------- /R/regex.R: -------------------------------------------------------------------------------- 1 | # basic checks 2 | isFunction <- function(code) 3 | grepl("^[[:alnum:][:space:]_&:<>]*\\([[:alnum:][:space:]_&:<>,]*\\)[[:space:]]*\\{", code) 4 | 5 | # pull the ampersand up to the type 6 | sanitize_amp <- function(code) gsub("[[:space:]]+&([[:alnum:]_])", "& \\1", code) 7 | 8 | # split into fdef, args, rest 9 | tokenize_signature <- function(code) 10 | strsplit(code, "[[:space:]]*(\\(|\\)){1}[[:space:]]*")[[1]] 11 | 12 | # get the arguments 13 | .args <- function(code, split=FALSE) { 14 | args <- tokenize_signature(code)[[2]] 15 | if (split) args <- strsplit(args, "[[:space:]]*,[[:space:]]*")[[1]] 16 | args 17 | } 18 | 19 | # get the function name 20 | .fname <- function(code) { 21 | tokens <- strsplit(tokenize_signature(code)[[1]], "[[:space:]]+")[[1]] 22 | tokens[[length(tokens)]] 23 | } 24 | 25 | # get the type (for a function or argument) 26 | .type <- function(code) { 27 | tokens <- strsplit(tokenize_signature(code)[[1]], "[[:space:]]+")[[1]] 28 | tokens <- tokens[seq_len(length(tokens)-1)] 29 | paste(tokens[tokens != ""], collapse=" ") 30 | } 31 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "README-" 12 | ) 13 | ``` 14 | 15 | # RcppXPtrUtils: XPtr Add-Ons for 'Rcpp' 16 | 17 | [![Build Status](https://github.com/Enchufa2/RcppXPtrUtils/actions/workflows/build.yml/badge.svg)](https://github.com/Enchufa2/RcppXPtrUtils/actions/workflows/build.yml) 18 | [![Coverage Status](https://codecov.io/gh/Enchufa2/RcppXPtrUtils/branch/master/graph/badge.svg)](https://app.codecov.io/gh/Enchufa2/RcppXPtrUtils) 19 | [![CRAN\_Status\_Badge](https://www.r-pkg.org/badges/version/RcppXPtrUtils)](https://cran.r-project.org/package=RcppXPtrUtils) 20 | [![Downloads](https://cranlogs.r-pkg.org/badges/RcppXPtrUtils)](https://cran.r-project.org/package=RcppXPtrUtils) 21 | 22 | The **RcppXPtrUtils** package provides the means to compile user-supplied C++ functions with 'Rcpp' and retrieve an XPtr that can be passed to other C++ components. 23 | 24 | ## Installation 25 | 26 | Install the release version from CRAN: 27 | 28 | ```{r, eval=FALSE} 29 | install.packages("RcppXPtrUtils") 30 | ``` 31 | 32 | The installation from GitHub can be done with the [remotes](https://cran.r-project.org/package=remotes) package: 33 | 34 | ```{r, eval=FALSE} 35 | remotes::install_github("Enchufa2/RcppXPtrUtils") 36 | ``` 37 | 38 | ## Use case 39 | 40 | Let's suppose we have a package with a core written in C++, connected to an R API with `Rcpp`. It accepts a user-supplied R function to perform some processing: 41 | 42 | ```{r, engine='Rcpp', eval=FALSE} 43 | #include 44 | using namespace Rcpp; 45 | 46 | template 47 | NumericVector core_processing(T func, double l) { 48 | double accum = 0; 49 | for (int i=0; i<1e3; i++) 50 | accum += sum(as(func(3, l))); 51 | return NumericVector(1, accum); 52 | } 53 | 54 | // [[Rcpp::export]] 55 | NumericVector execute_r(Function func, double l) { 56 | return core_processing(func, l); 57 | } 58 | ``` 59 | 60 | But calling R from C++ is slow, so we can think about improving the performance by accepting a compiled function. In order to do this, the core can be easily extended to accept an `XPtr` to a compiled function: 61 | 62 | ```{r, engine='Rcpp', eval=FALSE} 63 | typedef SEXP (*funcPtr)(int, double); 64 | 65 | // [[Rcpp::export]] 66 | NumericVector execute_cpp(SEXP func_, double l) { 67 | funcPtr func = *XPtr(func_); 68 | return core_processing(func, l); 69 | } 70 | ``` 71 | 72 | ```{r, engine='Rcpp', echo=FALSE} 73 | #include 74 | using namespace Rcpp; 75 | 76 | template 77 | NumericVector core_processing(T func, double l) { 78 | double accum = 0; 79 | for (int i=0; i<1e3; i++) 80 | accum += sum(as(func(3, l))); 81 | return NumericVector(1, accum); 82 | } 83 | 84 | // [[Rcpp::export]] 85 | NumericVector execute_r(Function func, double l) { 86 | return core_processing(func, l); 87 | } 88 | 89 | typedef SEXP (*funcPtr)(int, double); 90 | 91 | // [[Rcpp::export]] 92 | NumericVector execute_cpp(SEXP func_, double l) { 93 | funcPtr func = *XPtr(func_); 94 | return core_processing(func, l); 95 | } 96 | ``` 97 | 98 | To easily leverage this feature, the `RcppXPtrUtils` package provides `cppXPtr()`, which compiles a user-supplied C++ function using `Rcpp::cppFunction()` and returns an `XPtr`: 99 | 100 | ```{r} 101 | # compile the code above 102 | # Rcpp::sourceCpp(code='...') 103 | 104 | library(RcppXPtrUtils) 105 | 106 | func_r <- function(n, l) rexp(n, l) 107 | func_cpp <- cppXPtr("SEXP foo(int n, double l) { return rexp(n, l); }") 108 | 109 | microbenchmark::microbenchmark( 110 | execute_r(func_r, 1.5), 111 | execute_cpp(func_cpp, 1.5) 112 | ) 113 | ``` 114 | 115 | The object returned by `cppXPtr()` is just an `externalptr` wrapped into an object of class `XPtr`, which stores the signature of the function. If you are a package author, you probably want to re-export `cppXPtr()` and ensure that user-supplied C++ functions comply with the internal signatures in order to avoid runtime errors. This can be done with the `checkXPtr()` function: 116 | 117 | ```{r, error=TRUE} 118 | func_cpp 119 | checkXPtr(func_cpp, "SEXP", c("int", "double")) # returns silently 120 | checkXPtr(func_cpp, "int", c("int", "double")) 121 | checkXPtr(func_cpp, "SEXP", c("int")) 122 | checkXPtr(func_cpp, "SEXP", c("double", "int")) 123 | ``` 124 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # RcppXPtrUtils: XPtr Add-Ons for ‘Rcpp’ 5 | 6 | [![Build 7 | Status](https://github.com/Enchufa2/RcppXPtrUtils/actions/workflows/build.yml/badge.svg)](https://github.com/Enchufa2/RcppXPtrUtils/actions/workflows/build.yml) 8 | [![Coverage 9 | Status](https://codecov.io/gh/Enchufa2/RcppXPtrUtils/branch/master/graph/badge.svg)](https://app.codecov.io/gh/Enchufa2/RcppXPtrUtils) 10 | [![CRAN_Status_Badge](https://www.r-pkg.org/badges/version/RcppXPtrUtils)](https://cran.r-project.org/package=RcppXPtrUtils) 11 | [![Downloads](https://cranlogs.r-pkg.org/badges/RcppXPtrUtils)](https://cran.r-project.org/package=RcppXPtrUtils) 12 | 13 | The **RcppXPtrUtils** package provides the means to compile 14 | user-supplied C++ functions with ‘Rcpp’ and retrieve an XPtr that can be 15 | passed to other C++ components. 16 | 17 | ## Installation 18 | 19 | Install the release version from CRAN: 20 | 21 | ``` r 22 | install.packages("RcppXPtrUtils") 23 | ``` 24 | 25 | The installation from GitHub can be done with the 26 | [remotes](https://cran.r-project.org/package=remotes) package: 27 | 28 | ``` r 29 | remotes::install_github("Enchufa2/RcppXPtrUtils") 30 | ``` 31 | 32 | ## Use case 33 | 34 | Let’s suppose we have a package with a core written in C++, connected to 35 | an R API with `Rcpp`. It accepts a user-supplied R function to perform 36 | some processing: 37 | 38 | ``` cpp 39 | #include 40 | using namespace Rcpp; 41 | 42 | template 43 | NumericVector core_processing(T func, double l) { 44 | double accum = 0; 45 | for (int i=0; i<1e3; i++) 46 | accum += sum(as(func(3, l))); 47 | return NumericVector(1, accum); 48 | } 49 | 50 | // [[Rcpp::export]] 51 | NumericVector execute_r(Function func, double l) { 52 | return core_processing(func, l); 53 | } 54 | ``` 55 | 56 | But calling R from C++ is slow, so we can think about improving the 57 | performance by accepting a compiled function. In order to do this, the 58 | core can be easily extended to accept an `XPtr` to a compiled function: 59 | 60 | ``` cpp 61 | typedef SEXP (*funcPtr)(int, double); 62 | 63 | // [[Rcpp::export]] 64 | NumericVector execute_cpp(SEXP func_, double l) { 65 | funcPtr func = *XPtr(func_); 66 | return core_processing(func, l); 67 | } 68 | ``` 69 | 70 | To easily leverage this feature, the `RcppXPtrUtils` package provides 71 | `cppXPtr()`, which compiles a user-supplied C++ function using 72 | `Rcpp::cppFunction()` and returns an `XPtr`: 73 | 74 | ``` r 75 | # compile the code above 76 | # Rcpp::sourceCpp(code='...') 77 | 78 | library(RcppXPtrUtils) 79 | 80 | func_r <- function(n, l) rexp(n, l) 81 | func_cpp <- cppXPtr("SEXP foo(int n, double l) { return rexp(n, l); }") 82 | 83 | microbenchmark::microbenchmark( 84 | execute_r(func_r, 1.5), 85 | execute_cpp(func_cpp, 1.5) 86 | ) 87 | #> Unit: microseconds 88 | #> expr min lq mean median uq 89 | #> execute_r(func_r, 1.5) 14910.161 16261.928 17628.8078 17468.1140 18635.388 90 | #> execute_cpp(func_cpp, 1.5) 213.123 223.125 310.2708 237.0265 279.808 91 | #> max neval cld 92 | #> 22657.568 100 b 93 | #> 2417.878 100 a 94 | ``` 95 | 96 | The object returned by `cppXPtr()` is just an `externalptr` wrapped into 97 | an object of class `XPtr`, which stores the signature of the function. 98 | If you are a package author, you probably want to re-export `cppXPtr()` 99 | and ensure that user-supplied C++ functions comply with the internal 100 | signatures in order to avoid runtime errors. This can be done with the 101 | `checkXPtr()` function: 102 | 103 | ``` r 104 | func_cpp 105 | #> 'SEXP foo(int n, double l)' 106 | checkXPtr(func_cpp, "SEXP", c("int", "double")) # returns silently 107 | checkXPtr(func_cpp, "int", c("int", "double")) 108 | #> Error in checkXPtr(func_cpp, "int", c("int", "double")): Bad XPtr signature: 109 | #> Wrong return type 'int', should be 'SEXP'. 110 | checkXPtr(func_cpp, "SEXP", c("int")) 111 | #> Error in checkXPtr(func_cpp, "SEXP", c("int")): Bad XPtr signature: 112 | #> Wrong number of arguments, should be 2'. 113 | checkXPtr(func_cpp, "SEXP", c("double", "int")) 114 | #> Error in checkXPtr(func_cpp, "SEXP", c("double", "int")): Bad XPtr signature: 115 | #> Wrong argument type 'double', should be 'int'. 116 | #> Wrong argument type 'int', should be 'double'. 117 | ``` 118 | -------------------------------------------------------------------------------- /RcppXPtr.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Patch release (resubmission) 2 | 3 | Fixes CRAN issues. Fixes URLs. 4 | 5 | ## Test environments 6 | 7 | - Fedora 35 + GCC (local), R 4.1.3 8 | - macOS-latest, windows-latest, ubuntu-latest (on GA), R devel, release, oldrel 9 | - win-builder, R devel 10 | 11 | ## R CMD check results 12 | 13 | There were no ERRORs, WARNINGs or NOTEs. 14 | 15 | ## Downstream dependencies 16 | 17 | Shouldn't be affected by this minimal patch. 18 | -------------------------------------------------------------------------------- /man/checkXPtr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/check.R 3 | \name{checkXPtr} 4 | \alias{checkXPtr} 5 | \title{Check an \code{XPtr}'s Signature} 6 | \usage{ 7 | checkXPtr(ptr, type, args = character(), call. = TRUE) 8 | } 9 | \arguments{ 10 | \item{ptr}{an object of class \code{XPtr} compiled with \code{\link{cppXPtr}}.} 11 | 12 | \item{type}{the return type.} 13 | 14 | \item{args}{a list of argument types.} 15 | 16 | \item{call.}{logical, indicating if the call should become part of the error message.} 17 | } 18 | \description{ 19 | Check the signature (i.e., arguments and return type) of the output of 20 | \code{\link{cppXPtr}}, which is an external pointer wrapped in an object of 21 | class \code{XPtr}. If the user-supplied C++ function does not match the 22 | signature, the wrapper throws an informative error. 23 | } 24 | \examples{ 25 | \donttest{ 26 | # takes time to compile 27 | ptr <- cppXPtr("double foo(int a, double b) { return a + b; }") 28 | checkXPtr(ptr, "double", c("int", "double")) # returns silently 29 | try(checkXPtr(ptr, "int", c("double", "std::string"))) # throws error 30 | } 31 | } 32 | \seealso{ 33 | \code{\link{cppXPtr}} 34 | } 35 | -------------------------------------------------------------------------------- /man/cppXPtr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/cppXPtr.R 3 | \name{cppXPtr} 4 | \alias{cppXPtr} 5 | \title{Define an \code{XPtr} with a C++ Implementation} 6 | \usage{ 7 | cppXPtr( 8 | code, 9 | depends = character(), 10 | plugins = character(), 11 | includes = character(), 12 | rebuild = FALSE, 13 | cacheDir = getOption("rcpp.cache.dir", tempdir()), 14 | showOutput = verbose, 15 | verbose = getOption("verbose") 16 | ) 17 | } 18 | \arguments{ 19 | \item{code}{ 20 | Source code for the function definition. 21 | } 22 | 23 | \item{depends}{ 24 | Character vector of packages that the compilation depends on. Each package listed will first be queried for an \link[inline:plugins]{inline plugin} to determine header files to include. If no plugin is defined for the package then a header file based the package's name (e.g. \code{PkgName.h}) will be included. 25 | } 26 | 27 | \item{plugins}{ 28 | Character vector of \link[inline:plugins]{inline plugins} to use for the compilation. 29 | } 30 | 31 | \item{includes}{ 32 | Character vector of user includes (inserted after the includes provided by \code{depends}). 33 | } 34 | 35 | \item{rebuild}{ 36 | Force a rebuild of the shared library. 37 | } 38 | 39 | \item{cacheDir}{ 40 | Directory to use for caching shared libraries. If the underlying code passed to \code{sourceCpp} has not changed since the last invocation then a cached version of the shared library is used. The default value of \code{tempdir()} results in the cache being valid only for the current R session. Pass an alternate directory to preserve the cache across R sessions. 41 | } 42 | 43 | \item{showOutput}{ 44 | \code{TRUE} to print \code{R CMD SHLIB} output to the console. 45 | } 46 | 47 | \item{verbose}{ 48 | \code{TRUE} to print detailed information about generated code to the console. 49 | } 50 | } 51 | \value{ 52 | An object of class \code{XPtr} that points to the compiled function. 53 | } 54 | \description{ 55 | Dynamically define an \code{XPtr} with C++ source code. Compiles and links a shared 56 | library with bindings to the C++ function using \code{\link[Rcpp]{cppFunction}}, 57 | then returns an \code{XPtr} that points to the function and can be used to be 58 | plugged into another C++ backend. 59 | } 60 | \examples{ 61 | \donttest{ 62 | # takes time to compile 63 | ptr <- cppXPtr("double foo(int a, double b) { return a + b; }") 64 | class(ptr) 65 | print(ptr) 66 | } 67 | } 68 | \seealso{ 69 | \code{\link[Rcpp]{cppFunction}}, \code{\link{checkXPtr}} 70 | } 71 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | Sys.setenv("R_TESTS" = "") 2 | library(testthat) 3 | library(RcppXPtrUtils) 4 | test_check("RcppXPtrUtils") 5 | detach("package:RcppXPtrUtils", unload = TRUE) 6 | -------------------------------------------------------------------------------- /tests/testthat/test-check.R: -------------------------------------------------------------------------------- 1 | context("check") 2 | 3 | Rcpp::cppFunction(" 4 | NumericVector execute_cpp(SEXP func_, int n, double l) { 5 | typedef SEXP (*funcPtr)(int, double); 6 | funcPtr func = *XPtr(func_); 7 | return func(n, l); 8 | }", verbose=TRUE) 9 | 10 | ptr <- cppXPtr("SEXP foo(int n, double l) { return NumericVector(n, l); }", verbose=TRUE) 11 | 12 | test_that("A valid XPtr is returned", { 13 | expect_type(ptr, "externalptr") 14 | expect_true(inherits(ptr, "XPtr")) 15 | expect_equal(names(attributes(ptr)), c("class", "type", "fname", "args")) 16 | expect_silent(checkXPtr(ptr, "SEXP", c("int", "double"))) 17 | expect_output(print(ptr), "'SEXP foo\\(int n, double l\\)'") 18 | expect_equal(execute_cpp(ptr, 10, 3.3), rep(3.3, 10)) 19 | }) 20 | 21 | test_that("Wrong signatures throw an error", { 22 | expect_error(checkXPtr(ptr, "int", c("int", "double"))) 23 | expect_error(checkXPtr(ptr, "SEXP", c("int"))) 24 | expect_error(checkXPtr(ptr, "SEXP", c("double", "int"))) 25 | }) 26 | -------------------------------------------------------------------------------- /tests/testthat/test-regex.R: -------------------------------------------------------------------------------- 1 | context("regex") 2 | 3 | complex_function <- "\n const \n std::vector& \n _foo \n ( \n const 4 | \n std::vector& \n a_a \n , \n int \n b \n ) \n { \n }" 5 | 6 | test_that("basic function checks work as expected", { 7 | expect_false(isFunction("asdf asdf()")) 8 | expect_false(isFunction("asdf {}")) 9 | expect_false(isFunction("asdf asdf ( {}")) 10 | expect_false(isFunction("asdf asdf ) {}")) 11 | expect_true(isFunction("asdf asdf ( ) {}")) 12 | expect_true(isFunction(complex_function)) 13 | }) 14 | 15 | test_that("the ampersand is sanitized", { 16 | expect_equal(sanitize_amp("asdf& asdf &asdf"), "asdf& asdf& asdf") 17 | expect_equal(sanitize_amp("asdf &asdf &asdf"), "asdf& asdf& asdf") 18 | }) 19 | 20 | test_that("function name, arguments and return type are recognized", { 21 | expect_equal(.fname(complex_function), "_foo") 22 | expect_equal(.type(complex_function), "const std::vector&") 23 | expect_equal(.args(complex_function), "const\n\n std::vector& \n a_a \n , \n int \n b") 24 | expect_equal(sapply(.args(complex_function, split=TRUE), .type, USE.NAMES=FALSE), 25 | c("const std::vector&", "int")) 26 | }) 27 | -------------------------------------------------------------------------------- /working_dir/core.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | using namespace Rcpp; 3 | 4 | template 5 | NumericVector core_processing(T func, int n, double l) { 6 | double accum = 0; 7 | for (int i=0; i<1e3; i++) 8 | accum += sum(as(func(n, l))); 9 | return NumericVector(1, accum); 10 | } 11 | 12 | // [[Rcpp::export]] 13 | NumericVector execute_r(Function func, int n, double l) { 14 | return core_processing(func, n, l); 15 | } 16 | 17 | typedef SEXP (*funcPtr)(int, double); 18 | 19 | // [[Rcpp::export]] 20 | NumericVector execute_cpp(SEXP func_, int n, double l) { 21 | funcPtr func = *XPtr(func_); 22 | return core_processing(func, n, l); 23 | } 24 | -------------------------------------------------------------------------------- /working_dir/main.R: -------------------------------------------------------------------------------- 1 | library(RcppXPtrUtils) 2 | 3 | Rcpp::sourceCpp("working_dir/core.cpp") 4 | 5 | func_r <- function(n, l) rexp(n, l) 6 | func_cpp <- cppXPtr("SEXP foo(int n, double l) { return rexp(n, l); }") 7 | 8 | microbenchmark::microbenchmark( 9 | execute_r(func_r, 3, 1), 10 | execute_cpp(func_cpp, 3, 1) 11 | ) 12 | --------------------------------------------------------------------------------