Codebase list r-cran-bindrcpp / 976f035
New upstream version 0.2 Andreas Tille 6 years ago
24 changed file(s) with 871 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+27
-0
DESCRIPTION less more
0 Package: bindrcpp
1 Title: An 'Rcpp' Interface to Active Bindings
2 Description: Provides an easy way to fill an environment with active bindings
3 that call a C++ function.
4 Authors@R: c(
5 person("Kirill", "Müller", role = c("aut", "cre"), email = "krlmlr+r@mailbox.org"),
6 person("RStudio", role = "cph")
7 )
8 Version: 0.2
9 Date: 2017-06-15
10 URL: https://github.com/krlmlr/bindrcpp,
11 https://krlmlr.github.io/bindrcpp
12 BugReports: https://github.com/krlmlr/bindrcpp/issues
13 Imports: Rcpp, bindr
14 Suggests: testthat
15 LinkingTo: Rcpp, plogr
16 RoxygenNote: 6.0.1
17 LazyData: true
18 License: MIT + file LICENSE
19 Encoding: UTF-8
20 NeedsCompilation: yes
21 Packaged: 2017-06-15 20:53:22 UTC; muelleki
22 Author: Kirill Müller [aut, cre],
23 RStudio [cph]
24 Maintainer: Kirill Müller <krlmlr+r@mailbox.org>
25 Repository: CRAN
26 Date/Publication: 2017-06-17 23:52:40 UTC
+2
-0
LICENSE less more
0 YEAR: 2016
1 COPYRIGHT HOLDER: RStudio
+23
-0
MD5 less more
0 52470b405afa4c0d5172a439604ad6bd *DESCRIPTION
1 d3d2f503f5c96ac395a270e7c295ec0b *LICENSE
2 3a9c92677932609677f9a6370d097c29 *NAMESPACE
3 876a0477e3f61e936ef0fdb7211fdaaf *NEWS.md
4 7ddf9467cba4519d4692e5f6f1795806 *R/RcppExports.R
5 1ce0e6f00f32e2d0765fb57749317ec9 *R/bindr.R
6 b04097e5dbb70ea2d7bf5b0fee8acb46 *R/bindrcpp-package.R
7 2cdf48ce2f31adb3aea16cd398507126 *R/test.R
8 35837e0fbb8b9a53760fd747e6bdac89 *README.md
9 ebff110d87c1681eda6f30b93fa7ffde *inst/include/bindrcpp.h
10 fc7eea695d0dd9253a05637f8d7601da *inst/include/bindrcpp_RcppExports.h
11 51590efce84ef7ff9bf547c265cd66bf *inst/include/bindrcpp_types.h
12 aaf228a83c0e8d48ab132a5523ab5ccf *man/bindrcpp-package.Rd
13 fed1d0a4957c37ae234ceb655095f717 *man/init_logging.Rd
14 bfebf612b38c0d8e41f4f3449c290aa7 *man/reexports.Rd
15 3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars
16 3a3c839566f06a1eb4cb3c960b7cab62 *src/Makevars.win
17 9436f19309a6dcd8adc4fd9cb33930fd *src/RcppExports.cpp
18 5917fdf0957beca52727bb02dad6a90f *src/create.cpp
19 6492f645509837fe7c735958d71079d3 *src/plogr.cpp
20 4c5fafc9e32aea31f70fd316f4f0af9e *src/test.cpp
21 9d12bc91cc42c506ca4ac9a2184614b8 *tests/testthat.R
22 56632f0010990dc5ab5d734dfe763b95 *tests/testthat/test-create.R
+8
-0
NAMESPACE less more
0 # Generated by roxygen2: do not edit by hand
1
2 export(create_env)
3 export(populate_env)
4 importFrom(Rcpp,sourceCpp)
5 importFrom(bindr,create_env)
6 importFrom(bindr,populate_env)
7 useDynLib(bindrcpp)
+22
-0
NEWS.md less more
0 # bindrcpp 0.2 (2017-06-15)
1
2 - Fixed very rare segmentation fault due to missing protection of function arguments in autogenerated boilerplate code.
3 - Fix compilation errors on FreeBSD due to use of nonstandard Make features (#5).
4 - Native symbol registration added by Rcpp.
5
6
7 # bindrcpp 0.1 (2016-12-08)
8
9 Initial CRAN release.
10
11 ## Exported C++ functions
12
13 - `create_env_string()` creates an environment with active bindings, with names given as a character vector. Access of these bindings triggers a call to a C++ function with a fixed signature (`GETTER_FUNC_STRING`); this call contains the name of the binding (as character) and an arbitrary payload (`PAYLOAD`, essentially a wrapped `void*`).
14 - `create_env_symbol()` is similar, the callback function accepts the name of the binding as symbol instead of
15 character (`GETTER_FUNC_SYMBOL`).
16 - `populate_env_string()` and `populate_env_symbol()` populate an existing environment instead of creating a new one.
17 - Use `LinkingTo: bindrcpp` and `#include <bindrcpp.h>` to access these functions from your package.
18
19 ## Exported R functions
20
21 - Reexported from `bindr`: `create_env()` and `populate_env()`.
+32
-0
R/RcppExports.R less more
0 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 #' Enable internal logging
4 #'
5 #' Log entries, depending on the log level, will be printed to the standard
6 #' error stream.
7 #'
8 #' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB",
9 #' or "NONE".
10 #'
11 #' @keywords internal
12 init_logging <- function(log_level) {
13 invisible(.Call('bindrcpp_init_logging', PACKAGE = 'bindrcpp', log_level))
14 }
15
16 callback_string <- function(name, fun, payload) {
17 .Call('bindrcpp_callback_string', PACKAGE = 'bindrcpp', name, fun, payload)
18 }
19
20 callback_symbol <- function(name, fun, payload) {
21 .Call('bindrcpp_callback_symbol', PACKAGE = 'bindrcpp', name, fun, payload)
22 }
23
24 do_test_create_environment <- function(names, xform, parent) {
25 .Call('bindrcpp_do_test_create_environment', PACKAGE = 'bindrcpp', names, xform, parent)
26 }
27
28 # Register entry points for exported C++ functions
29 methods::setLoadAction(function(ns) {
30 .Call('bindrcpp_RcppExport_registerCCallable', PACKAGE = 'bindrcpp')
31 })
+5
-0
R/bindr.R less more
0 #' @export
1 bindr::create_env
2
3 #' @export
4 bindr::populate_env
+19
-0
R/bindrcpp-package.R less more
0 #' @details Use `LinkingTo: bindrcpp` in `DESCRIPTION` and
1 #' `#include <bindrcpp.h>` in your C++ headers and/or modules to access the
2 #' C++ functions provided by this package:
3 #'
4 #' - `create_env_string()` creates an environment with active bindings, with
5 #' names given as a character vector. Access of these bindings triggers a
6 #' call to a C++ function with a fixed signature (`GETTER_FUNC_STRING`);
7 #' this call contains the name of the binding (as character) and an arbitrary
8 #' payload (`PAYLOAD`, essentially a wrapped `void*`).
9 #' - `create_env_symbol()` is similar, the callback function accepts the name of
10 #' the binding as symbol instead of character (`GETTER_FUNC_SYMBOL`).
11 #' - `populate_env_string()` and `populate_env_symbol()` populate an existing
12 #' environment instead of creating a new one.
13 "_PACKAGE"
14
15 #' @useDynLib bindrcpp
16 #' @importFrom Rcpp sourceCpp
17 #' @importFrom bindr create_env populate_env
18 NULL
+3
-0
R/test.R less more
0 cpp_create_environment <- function(names, xform, parent = parent.frame()) {
1 do_test_create_environment(names, xform, parent)
2 }
+71
-0
README.md less more
0
1 <!-- README.md is generated from README.Rmd. Please edit that file -->
2 bindrcpp [![Travis-CI Build Status](https://travis-ci.org/krlmlr/bindrcpp.svg?branch=master)](https://travis-ci.org/krlmlr/bindrcpp) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/krlmlr/bindrcpp?branch=master&svg=true)](https://ci.appveyor.com/project/krlmlr/bindrcpp) [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/bindrcpp)](https://cran.r-project.org/package=bindrcpp)
3 ===============================================================================================================================================================================================================================================================================================================================================================================================================================
4
5 It's easy to create active bindings in R via [`makeActiveBinding()`](https://www.rdocumentation.org/packages/base/versions/3.3.1/topics/bindenv). This package faciliates the creation of active bindings that link back to C++ code. It provides an interface that allows binding several identifiers in an environment to the same C++ function, which is then called with the name (and a payload) as argument.
6
7 Installation
8 ------------
9
10 You can install bindrcpp from github with:
11
12 ``` r
13 # install.packages("devtools")
14 devtools::install_github("krlmlr/bindrcpp")
15 ```
16
17 Example
18 -------
19
20 The following C++ module exports a function `test_tolower_bindings()` that creates active bindings that return the binding name in lowercase.
21
22 ``` cpp
23 #include <Rcpp.h>
24
25 // [[Rcpp::depends(bindrcpp)]]
26 #include <bindrcpp.h>
27
28 #include <algorithm>
29 #include <string>
30
31 using namespace Rcpp;
32
33 using namespace bindrcpp;
34
35 SEXP tolower_callback(const String& name, PAYLOAD) {
36 std::string name_string = name;
37 std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower);
38 return CharacterVector(name_string);
39 }
40
41 // [[Rcpp::export]]
42 SEXP test_tolower_bindings(CharacterVector names, Environment parent) {
43 // We don't pass any payload here
44 return bindrcpp::create_env_string(
45 names, &tolower_callback, PAYLOAD(NULL), parent);
46 }
47 ```
48
49 This function can be called from R:
50
51 ``` r
52 env <- test_tolower_bindings(c("Converting", "to", "LOWERCASE"), .GlobalEnv)
53 ls(env)
54 #> [1] "Converting" "LOWERCASE" "to"
55 env$Converting
56 #> [1] "converting"
57 env$to
58 #> [1] "to"
59 env$LOWERCASE
60 #> [1] "lowercase"
61 env$y
62 #> NULL
63 ```
64
65 The bindings are read-only:
66
67 ``` r
68 env$Converting <- "CONVERTING"
69 #> Error: Binding is read-only.
70 ```
+9
-0
inst/include/bindrcpp.h less more
0 // Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 #ifndef RCPP_bindrcpp_H_GEN_
4 #define RCPP_bindrcpp_H_GEN_
5
6 #include "bindrcpp_RcppExports.h"
7
8 #endif // RCPP_bindrcpp_H_GEN_
+106
-0
inst/include/bindrcpp_RcppExports.h less more
0 // Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 #ifndef RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
4 #define RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
5
6 #include "bindrcpp_types.h"
7 #include <Rcpp.h>
8
9 namespace bindrcpp {
10
11 using namespace Rcpp;
12
13 namespace {
14 void validateSignature(const char* sig) {
15 Rcpp::Function require = Rcpp::Environment::base_env()["require"];
16 require("bindrcpp", Rcpp::Named("quietly") = true);
17 typedef int(*Ptr_validate)(const char*);
18 static Ptr_validate p_validate = (Ptr_validate)
19 R_GetCCallable("bindrcpp", "bindrcpp_RcppExport_validate");
20 if (!p_validate(sig)) {
21 throw Rcpp::function_not_exported(
22 "C++ function with signature '" + std::string(sig) + "' not found in bindrcpp");
23 }
24 }
25 }
26
27 inline Environment create_env_string(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) {
28 typedef SEXP(*Ptr_create_env_string)(SEXP,SEXP,SEXP,SEXP);
29 static Ptr_create_env_string p_create_env_string = NULL;
30 if (p_create_env_string == NULL) {
31 validateSignature("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)");
32 p_create_env_string = (Ptr_create_env_string)R_GetCCallable("bindrcpp", "bindrcpp_create_env_string");
33 }
34 RObject rcpp_result_gen;
35 {
36 RNGScope RCPP_rngScope_gen;
37 rcpp_result_gen = p_create_env_string(Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)), Shield<SEXP>(Rcpp::wrap(enclos)));
38 }
39 if (rcpp_result_gen.inherits("interrupted-error"))
40 throw Rcpp::internal::InterruptedException();
41 if (rcpp_result_gen.inherits("try-error"))
42 throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
43 return Rcpp::as<Environment >(rcpp_result_gen);
44 }
45
46 inline Environment populate_env_string(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
47 typedef SEXP(*Ptr_populate_env_string)(SEXP,SEXP,SEXP,SEXP);
48 static Ptr_populate_env_string p_populate_env_string = NULL;
49 if (p_populate_env_string == NULL) {
50 validateSignature("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)");
51 p_populate_env_string = (Ptr_populate_env_string)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_string");
52 }
53 RObject rcpp_result_gen;
54 {
55 RNGScope RCPP_rngScope_gen;
56 rcpp_result_gen = p_populate_env_string(Shield<SEXP>(Rcpp::wrap(env)), Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)));
57 }
58 if (rcpp_result_gen.inherits("interrupted-error"))
59 throw Rcpp::internal::InterruptedException();
60 if (rcpp_result_gen.inherits("try-error"))
61 throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
62 return Rcpp::as<Environment >(rcpp_result_gen);
63 }
64
65 inline Environment create_env_symbol(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) {
66 typedef SEXP(*Ptr_create_env_symbol)(SEXP,SEXP,SEXP,SEXP);
67 static Ptr_create_env_symbol p_create_env_symbol = NULL;
68 if (p_create_env_symbol == NULL) {
69 validateSignature("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)");
70 p_create_env_symbol = (Ptr_create_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_create_env_symbol");
71 }
72 RObject rcpp_result_gen;
73 {
74 RNGScope RCPP_rngScope_gen;
75 rcpp_result_gen = p_create_env_symbol(Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)), Shield<SEXP>(Rcpp::wrap(enclos)));
76 }
77 if (rcpp_result_gen.inherits("interrupted-error"))
78 throw Rcpp::internal::InterruptedException();
79 if (rcpp_result_gen.inherits("try-error"))
80 throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
81 return Rcpp::as<Environment >(rcpp_result_gen);
82 }
83
84 inline Environment populate_env_symbol(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
85 typedef SEXP(*Ptr_populate_env_symbol)(SEXP,SEXP,SEXP,SEXP);
86 static Ptr_populate_env_symbol p_populate_env_symbol = NULL;
87 if (p_populate_env_symbol == NULL) {
88 validateSignature("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)");
89 p_populate_env_symbol = (Ptr_populate_env_symbol)R_GetCCallable("bindrcpp", "bindrcpp_populate_env_symbol");
90 }
91 RObject rcpp_result_gen;
92 {
93 RNGScope RCPP_rngScope_gen;
94 rcpp_result_gen = p_populate_env_symbol(Shield<SEXP>(Rcpp::wrap(env)), Shield<SEXP>(Rcpp::wrap(names)), Shield<SEXP>(Rcpp::wrap(fun)), Shield<SEXP>(Rcpp::wrap(payload)));
95 }
96 if (rcpp_result_gen.inherits("interrupted-error"))
97 throw Rcpp::internal::InterruptedException();
98 if (rcpp_result_gen.inherits("try-error"))
99 throw Rcpp::exception(as<std::string>(rcpp_result_gen).c_str());
100 return Rcpp::as<Environment >(rcpp_result_gen);
101 }
102
103 }
104
105 #endif // RCPP_bindrcpp_RCPPEXPORTS_H_GEN_
+45
-0
inst/include/bindrcpp_types.h less more
0 #ifndef _bindrcpp_bindrcpp_types_H_
1 #define _bindrcpp_bindrcpp_types_H_
2
3 #include <RcppCommon.h>
4
5 #include <Rcpp.h>
6
7 namespace bindrcpp {
8
9 struct PAYLOAD { void* p; explicit PAYLOAD(void* p_) : p(p_) {}; };
10 typedef SEXP (*GETTER_FUNC_STRING)(const Rcpp::String& name, bindrcpp::PAYLOAD payload);
11 typedef SEXP (*GETTER_FUNC_SYMBOL)(const Rcpp::Symbol& name, bindrcpp::PAYLOAD payload);
12
13 }
14
15 namespace Rcpp {
16 using namespace bindrcpp;
17
18 template <> inline SEXP wrap(const PAYLOAD& payload) {
19 return List::create(XPtr<PAYLOAD>(new PAYLOAD(payload)));
20 }
21 template <> inline SEXP wrap(const GETTER_FUNC_STRING& fun) {
22 return List::create(XPtr<GETTER_FUNC_STRING>(new GETTER_FUNC_STRING(fun)));
23 }
24 template <> inline SEXP wrap(const GETTER_FUNC_SYMBOL& fun) {
25 return List::create(XPtr<GETTER_FUNC_SYMBOL>(new GETTER_FUNC_SYMBOL(fun)));
26 }
27 template <> inline PAYLOAD as(SEXP x) {
28 List xl = x;
29 XPtr<PAYLOAD> xpayload(static_cast<SEXP>(xl[0]));
30 return *xpayload.get();
31 }
32 template <> inline GETTER_FUNC_STRING as(SEXP x) {
33 List xl = x;
34 XPtr<GETTER_FUNC_STRING> xfun(static_cast<SEXP>(xl[0]));
35 return *xfun.get();
36 }
37 template <> inline GETTER_FUNC_SYMBOL as(SEXP x) {
38 List xl = x;
39 XPtr<GETTER_FUNC_SYMBOL> xfun(static_cast<SEXP>(xl[0]));
40 return *xfun.get();
41 }
42 }
43
44 #endif
+45
-0
man/bindrcpp-package.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/bindrcpp-package.R
2 \docType{package}
3 \name{bindrcpp-package}
4 \alias{bindrcpp}
5 \alias{bindrcpp-package}
6 \title{bindrcpp: An 'Rcpp' Interface to Active Bindings}
7 \description{
8 Provides an easy way to fill an environment with active bindings
9 that call a C++ function.
10 }
11 \details{
12 Use \code{LinkingTo: bindrcpp} in \code{DESCRIPTION} and
13 \code{#include <bindrcpp.h>} in your C++ headers and/or modules to access the
14 C++ functions provided by this package:
15 \itemize{
16 \item \code{create_env_string()} creates an environment with active bindings, with
17 names given as a character vector. Access of these bindings triggers a
18 call to a C++ function with a fixed signature (\code{GETTER_FUNC_STRING});
19 this call contains the name of the binding (as character) and an arbitrary
20 payload (\code{PAYLOAD}, essentially a wrapped \code{void*}).
21 \item \code{create_env_symbol()} is similar, the callback function accepts the name of
22 the binding as symbol instead of character (\code{GETTER_FUNC_SYMBOL}).
23 \item \code{populate_env_string()} and \code{populate_env_symbol()} populate an existing
24 environment instead of creating a new one.
25 }
26 }
27 \seealso{
28 Useful links:
29 \itemize{
30 \item \url{https://github.com/krlmlr/bindrcpp}
31 \item \url{https://krlmlr.github.io/bindrcpp}
32 \item Report bugs at \url{https://github.com/krlmlr/bindrcpp/issues}
33 }
34
35 }
36 \author{
37 \strong{Maintainer}: Kirill Müller \email{krlmlr+r@mailbox.org}
38
39 Other contributors:
40 \itemize{
41 \item RStudio [copyright holder]
42 }
43
44 }
+17
-0
man/init_logging.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/RcppExports.R
2 \name{init_logging}
3 \alias{init_logging}
4 \title{Enable internal logging}
5 \usage{
6 init_logging(log_level)
7 }
8 \arguments{
9 \item{log_level}{A character value, one of "WARN", "INFO", "DEBUG", "VERB",
10 or "NONE".}
11 }
12 \description{
13 Log entries, depending on the log level, will be printed to the standard
14 error stream.
15 }
16 \keyword{internal}
+18
-0
man/reexports.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/bindr.R
2 \docType{import}
3 \name{reexports}
4 \alias{reexports}
5 \alias{create_env}
6 \alias{reexports}
7 \alias{populate_env}
8 \title{Objects exported from other packages}
9 \keyword{internal}
10 \description{
11 These objects are imported from other packages. Follow the links
12 below to see their documentation.
13
14 \describe{
15 \item{bindr}{\code{\link[bindr]{create_env}}, \code{\link[bindr]{populate_env}}}
16 }}
17
+1
-0
src/Makevars less more
0 PKG_CPPFLAGS = -I../inst/include -I.
+1
-0
src/Makevars.win less more
0 PKG_CPPFLAGS = -I../inst/include -I.
+230
-0
src/RcppExports.cpp less more
0 // Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 #include "../inst/include/bindrcpp.h"
4 #include "../inst/include/bindrcpp_types.h"
5 #include <Rcpp.h>
6 #include <string>
7 #include <set>
8
9 using namespace Rcpp;
10
11 // create_env_string_imp
12 Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos);
13 static SEXP bindrcpp_create_env_string_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
14 BEGIN_RCPP
15 Rcpp::RObject rcpp_result_gen;
16 Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
17 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
18 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
19 Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP);
20 rcpp_result_gen = Rcpp::wrap(create_env_string_imp(names, fun, payload, enclos));
21 return rcpp_result_gen;
22 END_RCPP_RETURN_ERROR
23 }
24 RcppExport SEXP bindrcpp_create_env_string_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
25 SEXP rcpp_result_gen;
26 {
27 Rcpp::RNGScope rcpp_rngScope_gen;
28 rcpp_result_gen = PROTECT(bindrcpp_create_env_string_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP));
29 }
30 Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
31 if (rcpp_isInterrupt_gen) {
32 UNPROTECT(1);
33 Rf_onintr();
34 }
35 Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
36 if (rcpp_isError_gen) {
37 SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
38 UNPROTECT(1);
39 Rf_error(CHAR(rcpp_msgSEXP_gen));
40 }
41 UNPROTECT(1);
42 return rcpp_result_gen;
43 }
44 // populate_env_string_imp
45 Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload);
46 static SEXP bindrcpp_populate_env_string_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
47 BEGIN_RCPP
48 Rcpp::RObject rcpp_result_gen;
49 Rcpp::traits::input_parameter< Environment >::type env(envSEXP);
50 Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
51 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
52 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
53 rcpp_result_gen = Rcpp::wrap(populate_env_string_imp(env, names, fun, payload));
54 return rcpp_result_gen;
55 END_RCPP_RETURN_ERROR
56 }
57 RcppExport SEXP bindrcpp_populate_env_string_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
58 SEXP rcpp_result_gen;
59 {
60 Rcpp::RNGScope rcpp_rngScope_gen;
61 rcpp_result_gen = PROTECT(bindrcpp_populate_env_string_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP));
62 }
63 Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
64 if (rcpp_isInterrupt_gen) {
65 UNPROTECT(1);
66 Rf_onintr();
67 }
68 Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
69 if (rcpp_isError_gen) {
70 SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
71 UNPROTECT(1);
72 Rf_error(CHAR(rcpp_msgSEXP_gen));
73 }
74 UNPROTECT(1);
75 return rcpp_result_gen;
76 }
77 // create_env_symbol_imp
78 Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos);
79 static SEXP bindrcpp_create_env_symbol_imp_try(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
80 BEGIN_RCPP
81 Rcpp::RObject rcpp_result_gen;
82 Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
83 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
84 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
85 Rcpp::traits::input_parameter< Environment >::type enclos(enclosSEXP);
86 rcpp_result_gen = Rcpp::wrap(create_env_symbol_imp(names, fun, payload, enclos));
87 return rcpp_result_gen;
88 END_RCPP_RETURN_ERROR
89 }
90 RcppExport SEXP bindrcpp_create_env_symbol_imp(SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP, SEXP enclosSEXP) {
91 SEXP rcpp_result_gen;
92 {
93 Rcpp::RNGScope rcpp_rngScope_gen;
94 rcpp_result_gen = PROTECT(bindrcpp_create_env_symbol_imp_try(namesSEXP, funSEXP, payloadSEXP, enclosSEXP));
95 }
96 Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
97 if (rcpp_isInterrupt_gen) {
98 UNPROTECT(1);
99 Rf_onintr();
100 }
101 Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
102 if (rcpp_isError_gen) {
103 SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
104 UNPROTECT(1);
105 Rf_error(CHAR(rcpp_msgSEXP_gen));
106 }
107 UNPROTECT(1);
108 return rcpp_result_gen;
109 }
110 // populate_env_symbol_imp
111 Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload);
112 static SEXP bindrcpp_populate_env_symbol_imp_try(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
113 BEGIN_RCPP
114 Rcpp::RObject rcpp_result_gen;
115 Rcpp::traits::input_parameter< Environment >::type env(envSEXP);
116 Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
117 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
118 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
119 rcpp_result_gen = Rcpp::wrap(populate_env_symbol_imp(env, names, fun, payload));
120 return rcpp_result_gen;
121 END_RCPP_RETURN_ERROR
122 }
123 RcppExport SEXP bindrcpp_populate_env_symbol_imp(SEXP envSEXP, SEXP namesSEXP, SEXP funSEXP, SEXP payloadSEXP) {
124 SEXP rcpp_result_gen;
125 {
126 Rcpp::RNGScope rcpp_rngScope_gen;
127 rcpp_result_gen = PROTECT(bindrcpp_populate_env_symbol_imp_try(envSEXP, namesSEXP, funSEXP, payloadSEXP));
128 }
129 Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error");
130 if (rcpp_isInterrupt_gen) {
131 UNPROTECT(1);
132 Rf_onintr();
133 }
134 Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error");
135 if (rcpp_isError_gen) {
136 SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen);
137 UNPROTECT(1);
138 Rf_error(CHAR(rcpp_msgSEXP_gen));
139 }
140 UNPROTECT(1);
141 return rcpp_result_gen;
142 }
143 // init_logging
144 void init_logging(const std::string& log_level);
145 RcppExport SEXP bindrcpp_init_logging(SEXP log_levelSEXP) {
146 BEGIN_RCPP
147 Rcpp::RNGScope rcpp_rngScope_gen;
148 Rcpp::traits::input_parameter< const std::string& >::type log_level(log_levelSEXP);
149 init_logging(log_level);
150 return R_NilValue;
151 END_RCPP
152 }
153 // callback_string
154 SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload);
155 RcppExport SEXP bindrcpp_callback_string(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) {
156 BEGIN_RCPP
157 Rcpp::RObject rcpp_result_gen;
158 Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP);
159 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_STRING >::type fun(funSEXP);
160 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
161 rcpp_result_gen = Rcpp::wrap(callback_string(name, fun, payload));
162 return rcpp_result_gen;
163 END_RCPP
164 }
165 // callback_symbol
166 SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload);
167 RcppExport SEXP bindrcpp_callback_symbol(SEXP nameSEXP, SEXP funSEXP, SEXP payloadSEXP) {
168 BEGIN_RCPP
169 Rcpp::RObject rcpp_result_gen;
170 Rcpp::traits::input_parameter< Symbol >::type name(nameSEXP);
171 Rcpp::traits::input_parameter< bindrcpp::GETTER_FUNC_SYMBOL >::type fun(funSEXP);
172 Rcpp::traits::input_parameter< bindrcpp::PAYLOAD >::type payload(payloadSEXP);
173 rcpp_result_gen = Rcpp::wrap(callback_symbol(name, fun, payload));
174 return rcpp_result_gen;
175 END_RCPP
176 }
177 // do_test_create_environment
178 List do_test_create_environment(CharacterVector names, String xform, Environment parent);
179 RcppExport SEXP bindrcpp_do_test_create_environment(SEXP namesSEXP, SEXP xformSEXP, SEXP parentSEXP) {
180 BEGIN_RCPP
181 Rcpp::RObject rcpp_result_gen;
182 Rcpp::RNGScope rcpp_rngScope_gen;
183 Rcpp::traits::input_parameter< CharacterVector >::type names(namesSEXP);
184 Rcpp::traits::input_parameter< String >::type xform(xformSEXP);
185 Rcpp::traits::input_parameter< Environment >::type parent(parentSEXP);
186 rcpp_result_gen = Rcpp::wrap(do_test_create_environment(names, xform, parent));
187 return rcpp_result_gen;
188 END_RCPP
189 }
190
191 // validate (ensure exported C++ functions exist before calling them)
192 static int bindrcpp_RcppExport_validate(const char* sig) {
193 static std::set<std::string> signatures;
194 if (signatures.empty()) {
195 signatures.insert("Environment(*create_env_string)(CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD,Environment)");
196 signatures.insert("Environment(*populate_env_string)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_STRING,bindrcpp::PAYLOAD)");
197 signatures.insert("Environment(*create_env_symbol)(CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD,Environment)");
198 signatures.insert("Environment(*populate_env_symbol)(Environment,CharacterVector,bindrcpp::GETTER_FUNC_SYMBOL,bindrcpp::PAYLOAD)");
199 }
200 return signatures.find(sig) != signatures.end();
201 }
202
203 // registerCCallable (register entry points for exported C++ functions)
204 RcppExport SEXP bindrcpp_RcppExport_registerCCallable() {
205 R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_string", (DL_FUNC)bindrcpp_create_env_string_imp_try);
206 R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_string", (DL_FUNC)bindrcpp_populate_env_string_imp_try);
207 R_RegisterCCallable("bindrcpp", "bindrcpp_create_env_symbol", (DL_FUNC)bindrcpp_create_env_symbol_imp_try);
208 R_RegisterCCallable("bindrcpp", "bindrcpp_populate_env_symbol", (DL_FUNC)bindrcpp_populate_env_symbol_imp_try);
209 R_RegisterCCallable("bindrcpp", "bindrcpp_RcppExport_validate", (DL_FUNC)bindrcpp_RcppExport_validate);
210 return R_NilValue;
211 }
212
213 static const R_CallMethodDef CallEntries[] = {
214 {"bindrcpp_create_env_string_imp", (DL_FUNC) &bindrcpp_create_env_string_imp, 4},
215 {"bindrcpp_populate_env_string_imp", (DL_FUNC) &bindrcpp_populate_env_string_imp, 4},
216 {"bindrcpp_create_env_symbol_imp", (DL_FUNC) &bindrcpp_create_env_symbol_imp, 4},
217 {"bindrcpp_populate_env_symbol_imp", (DL_FUNC) &bindrcpp_populate_env_symbol_imp, 4},
218 {"bindrcpp_init_logging", (DL_FUNC) &bindrcpp_init_logging, 1},
219 {"bindrcpp_callback_string", (DL_FUNC) &bindrcpp_callback_string, 3},
220 {"bindrcpp_callback_symbol", (DL_FUNC) &bindrcpp_callback_symbol, 3},
221 {"bindrcpp_do_test_create_environment", (DL_FUNC) &bindrcpp_do_test_create_environment, 3},
222 {"bindrcpp_RcppExport_registerCCallable", (DL_FUNC) &bindrcpp_RcppExport_registerCCallable, 0},
223 {NULL, NULL, 0}
224 };
225
226 RcppExport void R_init_bindrcpp(DllInfo *dll) {
227 R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
228 R_useDynamicSymbols(dll, FALSE);
229 }
+49
-0
src/create.cpp less more
0 #include <Rcpp.h>
1
2 #include <bindrcpp.h>
3
4 #include <plogr.h>
5
6 using namespace Rcpp;
7
8 Environment pkg_env = Environment::namespace_env("bindrcpp");
9 Function R_create_env("create_env", pkg_env);
10 Function R_populate_env("populate_env", pkg_env);
11 Function R_callback_string("callback_string", pkg_env);
12 Function R_callback_symbol("callback_symbol", pkg_env);
13
14 // [[Rcpp::interfaces(cpp)]]
15 // [[Rcpp::export(create_env_string)]]
16 Environment create_env_string_imp(CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload, Environment enclos) {
17 using namespace bindrcpp;
18
19 LOG_VERBOSE << payload.p;
20 return R_create_env(names, R_callback_string, fun, payload, _[".enclos"] = enclos);
21 }
22
23 // [[Rcpp::interfaces(cpp)]]
24 // [[Rcpp::export(populate_env_string)]]
25 Environment populate_env_string_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
26 using namespace bindrcpp;
27
28 LOG_VERBOSE << payload.p;
29 return R_populate_env(env, names, R_callback_string, fun, payload);
30 }
31
32 // [[Rcpp::interfaces(cpp)]]
33 // [[Rcpp::export(create_env_symbol)]]
34 Environment create_env_symbol_imp(CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload, Environment enclos) {
35 using namespace bindrcpp;
36
37 LOG_VERBOSE << payload.p;
38 return R_create_env(names, R_callback_symbol, fun, payload, _[".enclos"] = enclos);
39 }
40
41 // [[Rcpp::interfaces(cpp)]]
42 // [[Rcpp::export(populate_env_symbol)]]
43 Environment populate_env_symbol_imp(Environment env, CharacterVector names, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
44 using namespace bindrcpp;
45
46 LOG_VERBOSE << payload.p;
47 return R_populate_env(env, names, R_callback_symbol, fun, payload);
48 }
+15
-0
src/plogr.cpp less more
0 #include <plogr.h>
1
2 //' Enable internal logging
3 //'
4 //' Log entries, depending on the log level, will be printed to the standard
5 //' error stream.
6 //'
7 //' @param log_level A character value, one of "WARN", "INFO", "DEBUG", "VERB",
8 //' or "NONE".
9 //'
10 //' @keywords internal
11 // [[Rcpp::export]]
12 void init_logging(const std::string& log_level) {
13 plog::init_r(log_level);
14 }
+91
-0
src/test.cpp less more
0 #include <Rcpp.h>
1
2 #include <bindrcpp.h>
3
4 #include <plogr.h>
5
6 #include <algorithm>
7 #include <string>
8
9 using namespace Rcpp;
10
11 using namespace bindrcpp;
12
13 // [[Rcpp::export(rng = FALSE)]]
14 SEXP callback_string(Symbol name, bindrcpp::GETTER_FUNC_STRING fun, bindrcpp::PAYLOAD payload) {
15 LOG_VERBOSE << type2name(name);
16 LOG_VERBOSE << payload.p;
17
18 String name_string = name.c_str();
19 name_string.set_encoding(CE_NATIVE);
20
21 return fun(name_string, payload);
22 }
23
24 // [[Rcpp::export(rng = FALSE)]]
25 SEXP callback_symbol(Symbol name, bindrcpp::GETTER_FUNC_SYMBOL fun, bindrcpp::PAYLOAD payload) {
26 LOG_VERBOSE << type2name(name);
27 LOG_VERBOSE << payload.p;
28
29 return fun(name, payload);
30 }
31
32 class CallbackTester {
33 enum { MAGIC = 20161014 };
34 const int magic;
35
36 public:
37 CallbackTester() : magic(MAGIC) { LOG_VERBOSE; }
38 ~CallbackTester() { LOG_VERBOSE; }
39
40 static SEXP tolower_static(const Rcpp::String& name, PAYLOAD payload) {
41 LOG_VERBOSE << payload.p;
42 CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p);
43 return this_->tolower(name);
44 }
45
46 static SEXP toupper_static(const Rcpp::String& name, PAYLOAD payload) {
47 LOG_VERBOSE << payload.p;
48 CallbackTester* this_ = reinterpret_cast<CallbackTester*>(payload.p);
49 return this_->toupper(name);
50 }
51
52 private:
53 SEXP tolower(Rcpp::String name) {
54 LOG_VERBOSE << magic;
55 if (magic != MAGIC)
56 stop("payload lost");
57 std::string name_string = name;
58 std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::tolower);
59 return CharacterVector(name_string);
60 }
61
62 SEXP toupper(Rcpp::String name) {
63 LOG_VERBOSE << magic;
64 if (magic != MAGIC)
65 stop("payload lost");
66 std::string name_string = name;
67 std::transform(name_string.begin(), name_string.end(), name_string.begin(), ::toupper);
68 return CharacterVector(name_string);
69 }
70 };
71
72 // [[Rcpp::export]]
73 List do_test_create_environment(CharacterVector names, String xform, Environment parent) {
74 CallbackTester* pc = new CallbackTester;
75
76 List ret = List::create(_["callback"] = XPtr<CallbackTester>(pc));
77
78 if (xform == "tolower") {
79 ret["env"] = bindrcpp::create_env_string(
80 names, &CallbackTester::tolower_static, PAYLOAD(pc), parent);
81 }
82 else if (xform == "toupper") {
83 ret["env"] = bindrcpp::create_env_string(
84 names, &CallbackTester::toupper_static, PAYLOAD(pc), parent);
85 }
86 else
87 stop("unknown xform");
88
89 return ret;
90 }
+28
-0
tests/testthat/test-create.R less more
0 context("create")
1
2 test_that("cpp_create_environment()", {
3 env_cb <- cpp_create_environment(letters, "toupper")
4 env <- env_cb$env
5 expect_equal(env$a, "A")
6 expect_equal(env$x, "X")
7 expect_null(env$X)
8 expect_equal(length(ls(env)), length(letters))
9 expect_error(env$a <- "a", "read-only")
10 })
11
12 test_that("cpp_create_environment() with inheritance", {
13 env_cb <- cpp_create_environment(letters, "toupper")
14 env <- env_cb$env
15 env2_cb <- cpp_create_environment(LETTERS, "tolower", parent = env)
16 env2 <- env2_cb$env
17 expect_equal(get("a", env2), "A")
18 expect_equal(get("x", env2), "X")
19 expect_null(env2$a)
20 expect_null(env2$x)
21 expect_equal(env2$B, "b")
22 expect_equal(env2$Y, "y")
23 expect_equal(length(ls(env2)), length(letters))
24 expect_error(env2$B <- "B", "read-only")
25 expect_error(env2$a <- "a", NA)
26 expect_equal(get("a", env2), "a")
27 })
+4
-0
tests/testthat.R less more
0 library(testthat)
1 library(bindrcpp)
2
3 test_check("bindrcpp")