decor/0000755000176200001440000000000014450070252011345 5ustar liggesusersdecor/NAMESPACE0000644000176200001440000000034214446512212012565 0ustar liggesusers# Generated by roxygen2: do not edit by hand export(cpp_decorations) export(cpp_files) export(parse_cpp_function) importFrom(tibble,tibble) importFrom(utils,head) importFrom(utils,tail) useDynLib(decor, .registration = TRUE) decor/LICENSE0000644000176200001440000000006114446515060012355 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: Posit Software, PBC decor/README.md0000644000176200001440000000115714373651567012652 0ustar liggesusers# decor [![R build status](https://github.com/jimhester/decor/workflows/R-CMD-check/badge.svg)](https://github.com/jimhester/decor/actions) [![Codecov test coverage](https://codecov.io/gh/jimhester/decor/branch/main/graph/badge.svg)](https://app.codecov.io/gh/jimhester/decor?branch=main) decor retrieves code comment decorations for C++ languages of the form `\\ [[xyz]]`, which are used for automated wrapping of C++ functions. ## Installation You can install the released version of decor from [CRAN](https://CRAN.R-project.org) with: ``` r install.packages("decor") ``` decor/man/0000755000176200001440000000000014446513440012126 5ustar liggesusersdecor/man/parse_cpp_function.Rd0000644000176200001440000000201414446512212016267 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decor.R \name{parse_cpp_function} \alias{parse_cpp_function} \title{Parse a C++ function} \usage{ parse_cpp_function(context, is_attribute = FALSE) } \arguments{ \item{context}{The function context, as obtained by the `context` column from [cpp_decorations()]} \item{is_attribute}{If `TRUE` the decorations are C++11 attributes, if `FALSE` they are comments.} } \value{ A tibble with the following fields: - name - The name of the function - return_type - The return type of the function - args - A list column containing a tibble of the functions arguments - type - The type of the argument - name - The name of the argument - default - The default value of the argument (if any). } \description{ Parses a C++ function returning a tibble with the function name and return type and a list column with the arguments of the function. } \examples{ # Setup context <- "int fun(int x) { return x + 1; }" # Parse the function parse_cpp_function(context) } decor/man/cpp_files.Rd0000644000176200001440000000135314446513440014363 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decor.R \name{cpp_files} \alias{cpp_files} \title{`C++` files from a package} \usage{ cpp_files(pkg = ".") } \arguments{ \item{pkg}{The path to a package's root directory.} } \value{ A character vector of `C++` files found in the package, ordered according to the C locale, for stability across different sessions and platforms. } \description{ `C++` files from a package } \examples{ # Setup pkg <- tempfile() dir.create(file.path(pkg, "src"), recursive = TRUE) file.create(file.path(pkg, "src", "code.c")) file.create(file.path(pkg, "src", "code.cpp")) # List the files, only the C++ file will be listed cpp_files(pkg) # Cleanup unlink(pkg, recursive = TRUE) } decor/man/cpp_decorations.Rd0000644000176200001440000000213114446513440015566 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/decor.R \name{cpp_decorations} \alias{cpp_decorations} \title{Decorations in a `C++` file} \usage{ cpp_decorations(pkg = ".", files = cpp_files(pkg = pkg), is_attribute = FALSE) } \arguments{ \item{pkg}{The path to a package's root directory.} \item{files}{Paths to `C++` files. If given, `pkg` will not be used.} \item{is_attribute}{If `TRUE` the decorations are C++11 attributes, if `FALSE` they are comments.} } \value{ A tibble with the decorations found, containing fields: - file - The filename for the decoration - line - The line the decoration was found - decoration - The name of the decoration - params - Any parameters given with the decoration - context - The text of the decoration line and all lines until the next decoration (or the end of the file). } \description{ Decorations in a `C++` file } \examples{ # Setup f <- tempfile() writeLines("[[cpp11::register]] int fun(int x = 1) { return x + 1; }", f) # Retrieve the decorations in the file cpp_decorations(files = f, is_attribute = TRUE) # Cleanup unlink(f) } decor/DESCRIPTION0000644000176200001440000000236114450070252013055 0ustar liggesusersPackage: decor Title: Retrieve Code Decorations Version: 1.0.2 Authors@R: c( person("Davis", "Vaughan", email = "davis@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4777-038X")), person("Romain", "François", role = "aut", comment = c(ORCID = "0000-0002-2444-4226")), person("Jim","Hester", role = "aut", comment = c(ORCID = "0000-0002-2739-7082")), person("Posit Software, PBC", role = c("cph", "fnd")) ) Description: Retrieves code comment decorations for C++ languages of the form '\\ [[xyz]]', which are used for automated wrapping of C++ functions. License: MIT + file LICENSE Depends: R (>= 3.3.0) Imports: tibble, utils, vctrs (>= 0.5.0) Suggests: covr, testthat Encoding: UTF-8 RoxygenNote: 7.2.3 URL: https://github.com/r-lib/decor BugReports: https://github.com/r-lib/decor/issues NeedsCompilation: yes Packaged: 2023-06-30 16:10:40 UTC; romainfrancois Author: Davis Vaughan [aut, cre] (), Romain François [aut] (), Jim Hester [aut] (), Posit Software, PBC [cph, fnd] Maintainer: Davis Vaughan Repository: CRAN Date/Publication: 2023-07-01 18:30:02 UTC decor/tests/0000755000176200001440000000000014373651567012531 5ustar liggesusersdecor/tests/testthat/0000755000176200001440000000000014450070252014347 5ustar liggesusersdecor/tests/testthat/test-decor.R0000644000176200001440000004115114373714520016554 0ustar liggesusersdescribe("cpp_files", { it("returns an empty character if there are no C++ files", { expect_equal(cpp_files(character()), character()) expect_equal(cpp_files(""), character()) d <- tempfile() on.exit(unlink(d, recursive = TRUE)) expect_equal(cpp_files(d), character()) dir.create(d) expect_equal(cpp_files(d), character()) dir.create(file.path(d, "src")) expect_equal(cpp_files(d), character()) file.create(file.path(d, "src", "foo")) expect_equal(cpp_files(d), character()) file.create(file.path(d, "src", "foo.c")) expect_equal(cpp_files(d), character()) file.create(file.path(d, "src", "foo")) expect_equal(cpp_files(d), character()) }) it("returns the C++ files if they exist", { d <- tempfile() on.exit(unlink(d, recursive = TRUE)) dir.create(d) dir.create(file.path(d, "src")) file.create(file.path(d, "src", "foo.cc")) expect_equal(basename(cpp_files(d)), "foo.cc") file.create(file.path(d, "src", "foo.cpp")) expect_equal(basename(cpp_files(d)), c("foo.cc", "foo.cpp")) file.create(file.path(d, "src", "foo.h")) expect_equal(basename(cpp_files(d)), c("foo.cc", "foo.cpp", "foo.h")) file.create(file.path(d, "src", "foo.hpp")) expect_equal(basename(cpp_files(d)), c("foo.cc", "foo.cpp", "foo.h", "foo.hpp")) }) it("returns the files ordered in the C locale", { d <- tempfile() on.exit(unlink(d, recursive = TRUE)) dir.create(d) dir.create(file.path(d, "src")) nms <- c("B.cc", "a.cc", "c.cc", "D.cc") file.create(file.path(d, "src", nms)) expect_equal(basename(cpp_files(d)), c("B.cc", "D.cc", "a.cc", "c.cc")) }) }) describe("cpp_decorations", { it("returns an 0 row tibble on empty inputs", { expect_equal( cpp_decorations(files = tempfile()), tibble( file = NA_character_, line = integer(), decoration = character(), params = list(), context = list() ) ) test_cpp_decorations( "", tibble( file = NA_character_, line = integer(), decoration = character(), params = list(), context = list() ) ) }) it("works with single commented decorations without parameters", { test_cpp_decorations( "// [[pkg::export]]\nvoid foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::export", params = list("pkg::export"), context = list(c("// [[pkg::export]]", "void foo() { }")) ) ) test_cpp_decorations( "// [[pkg::export]]\nvoid foo()\n{\n}", tibble( file = NA_character_, line = 1L, decoration = "pkg::export", params = list("pkg::export"), context = list(c("// [[pkg::export]]", "void foo()", "{", "}")) ) ) }) it("works with multiple commented decorations without parameters", { test_cpp_decorations( "// [[pkg::export]]\nvoid foo() { }\n// [[pkg::export]]\nvoid bar() { }", tibble( file = c(NA_character_, NA_character_), line = c(1L, 3L), decoration = c("pkg::export", "pkg::export"), params = list("pkg::export", "pkg::export"), context = list(c("// [[pkg::export]]", "void foo() { }"), c("// [[pkg::export]]", "void bar() { }")) ) ) }) it("works with multiple commented decorations in multiple files without parameters", { test_cpp_decorations( c( "// [[pkg::export]]\nvoid foo() { }\n// [[pkg::export]]\nvoid bar() { }", "// [[pkg::export]]\nvoid foo2() { }\n// [[pkg::export]]\nvoid bar2() { }" ), tibble( file = c( NA_character_, NA_character_, NA_character_, NA_character_ ), line = c(1L, 3L, 1L, 3L), decoration = c("pkg::export", "pkg::export", "pkg::export", "pkg::export"), params = list("pkg::export", "pkg::export", "pkg::export", "pkg::export"), context = list( c("// [[pkg::export]]", "void foo() { }"), c("// [[pkg::export]]", "void bar() { }"), c("// [[pkg::export]]", "void foo2() { }"), c("// [[pkg::export]]", "void bar2() { }") ) ) ) }) it("works with single commented decorations with parameters", { test_cpp_decorations( "// [[pkg::include(Bar)]]\nvoid foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::include", params = list(setNames(list(as.symbol("Bar")), "")), context = list(c("// [[pkg::include(Bar)]]", "void foo() { }")) ) ) test_cpp_decorations( "// [[pkg::include('Bar')]]\nvoid foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::include", params = list(setNames(list("Bar"), "")), context = list(c("// [[pkg::include('Bar')]]", "void foo() { }")) ) ) }) it("works with single commented decorations with named parameters", { test_cpp_decorations( "// [[pkg::include(foo = 'Bar')]]\nvoid foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::include", params = list(setNames(list("Bar"), "foo")), context = list(c("// [[pkg::include(foo = 'Bar')]]", "void foo() { }")) ) ) }) it("works with multiple commented decorations with named parameters", { test_cpp_decorations( "// [[pkg::include(foo = 'Bar')]]\nvoid foo() { }\n// [[pkg::include(foo = 'Baz')]]\nvoid bar() { }", tibble( file = c(NA_character_, NA_character_), line = c(1L, 3L), decoration = c("pkg::include", "pkg::include"), params = list( setNames(list("Bar"), "foo"), setNames(list("Baz"), "foo") ), context = list( c("// [[pkg::include(foo = 'Bar')]]", "void foo() { }"), c("// [[pkg::include(foo = 'Baz')]]", "void bar() { }") ) ) ) }) it("ignores non-commented decorations if is_attribute is FALSE", { test_cpp_decorations( "[[pkg::export]] void foo() { }", tibble( file = NA_character_, line = integer(), decoration = character(), params = list(), context = list() ) ) }) it("works with non-commented decorations", { test_cpp_decorations(is_attribute = TRUE, "[[pkg::export]] void foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::export", params = list("pkg::export"), context = list("[[pkg::export]] void foo() { }") ) ) }) it("works with non-commented decorations", { test_cpp_decorations(is_attribute = TRUE, "[[pkg::export]] void foo () { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::export", params = list("pkg::export"), context = list("[[pkg::export]] void foo () { }") ) ) }) it("works with multiple non-commented decorations with named parameters", { test_cpp_decorations(is_attribute = TRUE, "[[pkg::include(foo = 'Bar')]]\nvoid foo() { }\n[[pkg::include(foo = 'Baz')]]\nvoid bar() { }", tibble( file = c(NA_character_, NA_character_), line = c(1L, 3L), decoration = c("pkg::include", "pkg::include"), params = list( setNames(list("Bar"), "foo"), setNames(list("Baz"), "foo") ), context = list( c("[[pkg::include(foo = 'Bar')]]", "void foo() { }"), c("[[pkg::include(foo = 'Baz')]]", "void bar() { }") ) ) ) test_cpp_decorations(is_attribute = TRUE, "[[pkg::include(foo = 'Bar')]] void foo() { }", tibble( file = NA_character_, line = 1L, decoration = "pkg::include", params = list(setNames(list("Bar"), "foo")), context = list("[[pkg::include(foo = 'Bar')]] void foo() { }") ) ) }) }) describe("parse_cpp_function", { it("returns an 0 row tibble for empty inputs", { expect_equal( parse_cpp_function(character()), tibble( name = character(), return_type = character(), args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) expect_equal( parse_cpp_function(""), tibble( name = character(), return_type = character(), args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) }) it("works with zero argument functions without decorations", { expect_equal( parse_cpp_function("void foo() { }"), tibble( name = "foo", return_type = "void", args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) expect_equal( parse_cpp_function(c("void foo()", "{", "}")), tibble( name = "foo", return_type = "void", args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) }) it("works with zero argument functions with commented decorations", { expect_equal( parse_cpp_function(c("// [[pkg::export]]", "void foo()", "{", "}")), tibble( name = "foo", return_type = "void", args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) }) it("works with zero argument functions with non-commented decorations", { expect_equal( parse_cpp_function(c("[[pkg::export]]", "void foo()", "{", "}"), is_attribute = TRUE), tibble( name = "foo", return_type = "void", args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) expect_equal( parse_cpp_function(c("[[pkg::export]] void foo() { }"), is_attribute = TRUE), tibble( name = "foo", return_type = "void", args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) }) it("works with inline // comments for arguments", { expect_equal( parse_cpp_function(c('int foo(int a, // = 5', 'int b) {', 'return 0;', '}')), tibble( name = "foo", return_type = "int", args = list( tibble( type = c("int", "int"), name = c("a", "b"), default = c(NA_character_, NA_character_) ) ) ) ) }) it("works with functions taking arguments", { expect_equal( parse_cpp_function(c("double foo(int bar)", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = "int", name = "bar", default = NA_character_ ) ) ) ) expect_equal( parse_cpp_function(c("double foo(int bar)", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = "int", name = "bar", default = NA_character_ ) ) ) ) expect_equal( parse_cpp_function(c("double foo(int bar, const char* baz)", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char*"), name = c("bar", "baz"), default = c(NA_character_, NA_character_) ) ) ) ) expect_error( parse_cpp_function("raws C_encode(int x, strings) { }"), "has no type" ) expect_equal( parse_cpp_function(c("double foo(int bar, const char *baz)", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char *"), name = c("bar", "baz"), default = c(NA_character_, NA_character_) ) ) ) ) expect_equal( parse_cpp_function(c("double foo(int bar, int**baz)", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "int**"), name = c("bar", "baz"), default = c(NA_character_, NA_character_) ) ) ) ) }) it("works with functions with default arguments", { expect_equal( parse_cpp_function(c("double foo(int bar = 1, const char* baz = \"hi\")", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char*"), name = c("bar", "baz"), default = c("1", '"hi"') ) ) ) ) expect_equal( parse_cpp_function(c("double foo(int bar = 1, const char *baz = \"hi\")", "{", "}")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char *"), name = c("bar", "baz"), default = c("1", '"hi"') ) ) ) ) }) it("works with complex arguments", { expect_equal( parse_cpp_function(c("foo::bar foo(const char[] bar, const std::string& baz = \"hi\")", "{", "}")), tibble( name = "foo", return_type = "foo::bar", args = list( tibble( type = c("const char[]", "const std::string&"), name = c("bar", "baz"), default = c(NA_character_, '"hi"') ) ) ) ) expect_equal( parse_cpp_function(c("foo::bar foo(const char[] bar, const std::string &baz = \"hi\")", "{", "}")), tibble( name = "foo", return_type = "foo::bar", args = list( tibble( type = c("const char[]", "const std::string &"), name = c("bar", "baz"), default = c(NA_character_, '"hi"') ) ) ) ) expect_equal( parse_cpp_function(c("foo::bar foo(std::vector& bar, int baz = foo2())", "{", "}")), tibble( name = "foo", return_type = "foo::bar", args = list( tibble( type = c("std::vector&", "int"), name = c("bar", "baz"), default = c(NA_character_, 'foo2()') ) ) ) ) expect_equal( parse_cpp_function(c("foo::bar foo(std::vector &bar, int baz = foo2())", "{", "}")), tibble( name = "foo", return_type = "foo::bar", args = list( tibble( type = c("std::vector &", "int"), name = c("bar", "baz"), default = c(NA_character_, 'foo2()') ) ) ) ) }) it("works with declarations", { expect_equal( parse_cpp_function(c("double foo(int bar = 1, const char* baz = \"hi\");")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char*"), name = c("bar", "baz"), default = c("1", '"hi"') ) ) ) ) expect_equal( parse_cpp_function(c("double foo(int bar = 1, const char *baz = \"hi\");")), tibble( name = "foo", return_type = "double", args = list( tibble( type = c("int", "const char *"), name = c("bar", "baz"), default = c("1", '"hi"') ) ) ) ) }) describe("read_lines()", { it("works with empty files", { expect_equal(read_lines(content = character()), character()) }) it("returns the content if there are no comments", { expect_equal(read_lines(content = "'x' \"y\"\n z ** 2 / 1"), c("'x' \"y\"", " z ** 2 / 1")) }) it("returns the content with blanked comments for single line comments", { expect_equal(read_lines(content = "foo\n// bar\nbaz"), c("foo", " ", "baz")) }) it("returns the content with blanked comments for multi-line comments", { expect_equal(read_lines(content = "/* foo\n//' */bar\nbaz"), c(" ", " bar", "baz")) }) it("quoted comments are ignored", { expect_equal(read_lines(content = '"/*" foo\n\'// */\'bar\nbaz'), c('"/*" foo', "\'// */\'bar", "baz")) }) }) }) decor/tests/testthat/helper.R0000644000176200001440000000060014373651567015767 0ustar liggesuserstest_cpp_decorations <- function(content, results, is_attribute = FALSE) { files <- vapply(content, function(x) { f <- tempfile() writeLines(x, f) f }, character(1)) on.exit(unlink(files)) res <- cpp_decorations(files = files, is_attribute = is_attribute) if (NROW(res) > 0) { res$file <- NA_character_ } #return(res) expect_equal(res, results) } decor/tests/testthat/test-zzz.R0000644000176200001440000000026014373651567016324 0ustar liggesuserstest_that("map_if works with function predicates", { expect_equal( map_if(letters[1:5], function(x) identical(x, "c"), toupper), list("a", "b", "C", "d", "e") ) }) decor/tests/testthat.R0000644000176200001440000000006614373651567014516 0ustar liggesuserslibrary(testthat) library(decor) test_check("decor") decor/src/0000755000176200001440000000000014447577177012164 5ustar liggesusersdecor/src/parse_cpp_function.cpp0000644000176200001440000001332714447576056016552 0ustar liggesusers#define R_NO_REMAP #include #include #include #include #include static const char* const kWhitespaceChars = " \f\n\r\t\v"; static const char* const kWhiteDeRefChars = " \f\n\r\t\v*&"; void set_rownames(SEXP x, int n) { SEXP rownames = PROTECT(Rf_allocVector(INTSXP, 2)); INTEGER(rownames)[0] = NA_INTEGER; INTEGER(rownames)[1] = -n; Rf_setAttrib(x, R_RowNamesSymbol, rownames); UNPROTECT(1); } void set_tibble(SEXP x) { SEXP classes = PROTECT(Rf_allocVector(STRSXP, 3)); SET_STRING_ELT(classes, 0, Rf_mkChar("tbl_df")); SET_STRING_ELT(classes, 1, Rf_mkChar("tbl")); SET_STRING_ELT(classes, 2, Rf_mkChar("data.frame")); Rf_classgets(x, classes); UNPROTECT(1); } void trimWhitespace(std::string& s) { // skip empty case if (s.empty()) return; // trim right std::string::size_type pos = s.find_last_not_of(kWhitespaceChars); if (pos != std::string::npos) s.erase(pos + 1); // trim left pos = s.find_first_not_of(kWhitespaceChars); s.erase(0, pos); } SEXP parse_arguments(const std::string& args) { std::vector arguments; int templateCount = 0; int parenCount = 0; bool insideQuotes = false; std::string currentArg; char prevChar = 0; for (std::string::const_iterator it = args.begin(); it != args.end(); ++it) { char ch = *it; if (ch == '"' && prevChar != '\\') { insideQuotes = !insideQuotes; } if (ch == ',' && !templateCount && !parenCount && !insideQuotes) { arguments.push_back(currentArg); currentArg.clear(); } else { currentArg.push_back(ch); switch (ch) { case '<': templateCount++; break; case '>': templateCount--; break; case '(': parenCount++; break; case ')': parenCount--; break; } } prevChar = ch; } if (!currentArg.empty() && currentArg != "void") { arguments.push_back(currentArg); } int n = arguments.size(); SEXP type = PROTECT(Rf_allocVector(STRSXP, n)); SEXP def = PROTECT(Rf_allocVector(STRSXP, n)); SEXP name = PROTECT(Rf_allocVector(STRSXP, n)); bool ok = true; int i = 0; for (; i < n; i++) { std::string arg = arguments[i]; std::string::size_type start = arg.find_first_not_of(kWhitespaceChars); std::string::size_type end = arg.find_last_not_of(kWhitespaceChars); // find default value (if any). std::string::size_type eqPos = arg.find_first_of('=', start); if (eqPos != std::string::npos) { std::string::size_type default_start = arg.find_first_not_of(kWhitespaceChars, eqPos + 1); SET_STRING_ELT(def, i, Rf_mkCharLen(arg.data() + default_start, end - default_start + 1)); arg.erase(eqPos); } else { SET_STRING_ELT(def, i, NA_STRING); } // only keep (trimmed) part before the '=' arg.erase(0, start); end = arg.find_last_not_of(kWhitespaceChars); if (end != std::string::npos) { arg.erase(end + 1); } // where does the type end end = arg.find_last_of(kWhiteDeRefChars); if (end == std::string::npos) { ok = false; break; } // name SET_STRING_ELT(name, i, Rf_mkCharLen(arg.data() + end + 1, arg.size() - end - 1)); // type if (end == arg.find_last_of(kWhitespaceChars)) { SET_STRING_ELT(type, i, Rf_mkCharLen(arg.data(), end)); } else { SET_STRING_ELT(type, i, Rf_mkCharLen(arg.data(), end + 1)); } } if (!ok) { std::stringstream stream; stream << "Argument " << (i + 1) << " (" << arguments[i] << ") has no type"; SEXP out = Rf_mkString(stream.str().c_str()); UNPROTECT(3); // type, def, name return out; } else { SEXP tbl_args = PROTECT(Rf_allocVector(VECSXP, 3)); SEXP names = PROTECT(Rf_allocVector(STRSXP, 3)); SET_VECTOR_ELT(tbl_args, 0, type); SET_STRING_ELT(names, 0, Rf_mkChar("type")); SET_VECTOR_ELT(tbl_args, 1, name); SET_STRING_ELT(names, 1, Rf_mkChar("name")); SET_VECTOR_ELT(tbl_args, 2, def); SET_STRING_ELT(names, 2, Rf_mkChar("default")); Rf_namesgets(tbl_args, names); set_tibble(tbl_args); set_rownames(tbl_args, n); UNPROTECT(5); // type, def, name, tbl_args, names return tbl_args; } } extern "C" SEXP parse_cpp_function(SEXP signature_) { std::string signature = CHAR(STRING_ELT(signature_, 0)); // find last ')' and first '(' std::string::size_type endParenLoc = signature.find_last_of(')'); std::string::size_type beginParenLoc = signature.find_first_of('('); // find name of the function and return type std::string preamble = signature.substr(0, signature.find_last_not_of(kWhitespaceChars, beginParenLoc - 1) + 1); std::string::size_type sep = preamble.find_last_of(kWhitespaceChars); std::string name = preamble.substr(sep + 1); std::string return_type = preamble.substr(0, sep); std::string args = signature.substr(beginParenLoc + 1, endParenLoc - beginParenLoc - 1); trimWhitespace(args); SEXP res = PROTECT(Rf_allocVector(VECSXP, 3)); SEXP names = PROTECT(Rf_allocVector(STRSXP, 3)); SET_VECTOR_ELT(res, 0, PROTECT(Rf_mkString(name.c_str()))); SET_STRING_ELT(names, 0, Rf_mkChar("name")); SET_VECTOR_ELT(res, 1, PROTECT(Rf_mkString(return_type.c_str()))); SET_STRING_ELT(names, 1, Rf_mkChar("return_type")); SEXP args_lst = PROTECT(Rf_allocVector(VECSXP, 1)); SEXP args_parsed = PROTECT(parse_arguments(args)); if (TYPEOF(args_parsed) == STRSXP) { UNPROTECT(6); return args_parsed; } else { SET_VECTOR_ELT(args_lst, 0, args_parsed); SET_VECTOR_ELT(res, 2, args_lst); SET_STRING_ELT(names, 2, Rf_mkChar("args")); set_rownames(res, 1); set_tibble(res); Rf_setAttrib(res, R_NamesSymbol, names); UNPROTECT(6); return res; } } decor/src/init.c0000644000176200001440000000071514373651567013270 0ustar liggesusers#include #include #include SEXP parse_cpp_function(SEXP signature_); SEXP r_blank_comments(SEXP filename_); R_CallMethodDef callMethods[] = { {"decor_parse_cpp_function", (DL_FUNC)&parse_cpp_function, 1}, {"blank_comments", (DL_FUNC)&r_blank_comments, 1}, {NULL, NULL, 0}}; void R_init_decor(DllInfo* info) { R_registerRoutines(info, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(info, FALSE); } decor/src/blank_comments.cpp0000644000176200001440000000447414446550774015666 0ustar liggesusers#define R_NO_REMAP #include #include #include /* blanks all C and C++ style comments in a file, preserving newlines */ std::string blank_comments(std::string data) { enum state_t { NORMAL, SINGLE_LINE_COMMENT, MULTI_LINE_COMMENT, QUOTE, DOUBLE_QUOTE }; /* state table, _ | " | ' | /\* | // | *\/ | \n | N | D | Q | M | S | N | N | S | S | S | S | S | S | N | M | M | M | - | M | N | M | Q | Q | N | Q | Q | Q | Q | D | N | D | D | D | D | D | */ state_t state = NORMAL; const size_t len = data.size(); for (size_t i = 0; i < len; ++i) { switch (state) { case NORMAL: switch (data[i]) { case '\'': state = QUOTE; break; case '\"': state = DOUBLE_QUOTE; case '\\': break; case '/': if (i < len - 1 && data[i + 1] == '*') { state = MULTI_LINE_COMMENT; data[i] = ' '; ++i; data[i] = ' '; break; } if (i < len - 1 && data[i + 1] == '/') { state = SINGLE_LINE_COMMENT; data[i] = ' '; ++i; data[i] = ' '; break; } break; } break; case SINGLE_LINE_COMMENT: if (data[i] == '\n') { state = NORMAL; break; } data[i] = ' '; break; case MULTI_LINE_COMMENT: if (i < len - 1 && data[i] == '*' && data[i + 1] == '/') { state = NORMAL; data[i] = ' '; data[i + 1] = ' '; break; } if (data[i] != '\n' && data[i] != '\r') { data[i] = ' '; } case QUOTE: if (data[i] == '\'') { state = NORMAL; break; } break; case DOUBLE_QUOTE: if (data[i] == '\"') { state = NORMAL; break; } break; } } return data; } extern "C" SEXP r_blank_comments(SEXP data_) { const std::string data = blank_comments(CHAR(STRING_ELT(data_, 0))); SEXP out = PROTECT(Rf_allocVector(STRSXP, 1)); SET_STRING_ELT(out, 0, Rf_mkCharLenCE(data.data(), data.size(), CE_UTF8)); UNPROTECT(1); return out; } decor/R/0000755000176200001440000000000014446513440011554 5ustar liggesusersdecor/R/zzz.R0000644000176200001440000000100714373651567012546 0ustar liggesusers#' @useDynLib decor, .registration = TRUE #' @importFrom tibble tibble #' @importFrom utils head tail NULL map_if <- function(.x, .p, .f, ...) { if (is.function(.p)) { sel <- vapply(.x, .p, logical(1)) } else { sel <- .p } out <- vector("list", length(.x)) out[sel] <- lapply(.x[sel], .f, ...) out[!sel] <- .x[!sel] out } set_names <- function(x, nms = names2(x)) { names(x) <- nms x } names2 <- function(x) { if (is.null(names(x))) { names(x) <- rep("", length(x)) } names(x) } decor/R/decor.R0000644000176200001440000001320514446513440012774 0ustar liggesusers#' `C++` files from a package #' #' @param pkg The path to a package's root directory. #' #' @return A character vector of `C++` files found in the package, ordered #' according to the C locale, for stability across different sessions and #' platforms. #' @export #' @examples #' # Setup #' pkg <- tempfile() #' dir.create(file.path(pkg, "src"), recursive = TRUE) #' file.create(file.path(pkg, "src", "code.c")) #' file.create(file.path(pkg, "src", "code.cpp")) #' #' # List the files, only the C++ file will be listed #' cpp_files(pkg) #' #' # Cleanup #' unlink(pkg, recursive = TRUE) cpp_files <- function(pkg = ".") { if (length(pkg) == 0 || !nzchar(pkg[[1L]])) { return(character()) } src <- file.path(pkg, "src") if (!dir.exists(src)) { return(character()) } out <- list.files(src, full.names = TRUE, pattern = "[.](cc|cpp|h|hpp)$") # always sort these paths according to the C locale to avoid nuisance changes # in files generated downstream # TODO: switch to vctrs::vec_sort_radix() or vctrs::vec_sort() when possible out[order(vctrs::vec_rank(out))] } #' Decorations in a `C++` file #' #' @inheritParams cpp_files #' @param files Paths to `C++` files. If given, `pkg` will not be used. #' @param is_attribute If `TRUE` the decorations are C++11 attributes, if `FALSE` they are comments. #' @return A tibble with the decorations found, containing fields: #' - file - The filename for the decoration #' - line - The line the decoration was found #' - decoration - The name of the decoration #' - params - Any parameters given with the decoration #' - context - The text of the decoration line and all lines until the next decoration (or the end of the file). #' @export #' @examples #' # Setup #' f <- tempfile() #' writeLines("[[cpp11::register]] int fun(int x = 1) { return x + 1; }", f) #' #' # Retrieve the decorations in the file #' cpp_decorations(files = f, is_attribute = TRUE) #' #' # Cleanup #' unlink(f) cpp_decorations <- function(pkg = ".", files = cpp_files(pkg = pkg), is_attribute = FALSE) { res <- lapply(files, function(file) { if (!file.exists(file)) { return(tibble(file = character(), line = integer(), decoration = character(), params = list(), context = list())) } if (is_attribute) { lines <- read_lines(file) } else { lines <- readLines(file) } start <- grep(cpp_attribute_pattern(is_attribute), lines) if (!length(start)) { return(tibble(file = character(), line = integer(), decoration = character(), params = list(), context = list())) } end <- c(tail(start, -1L) - 1L, length(lines)) text <- lines[start] content <- sub(paste0(cpp_attribute_pattern(is_attribute), ".*"), "\\1", text) decoration <- sub("\\(.*$", "", content) has_args <- grepl("\\(", content) params <- map_if(content, has_args, function(.x) { set_names(as.list(parse(text = .x)[[1]][-1])) }) context <- mapply(function(.x, .y) lines[seq(.x, .y)], start, end, SIMPLIFY = FALSE) tibble(file, line = start, decoration, params, context) }) vctrs::vec_rbind(!!!res); } read_lines <- function(file, content = readChar(file, file.size(file))) { if (length(content) == 0) { return(character()) } without_comments <- .Call(blank_comments, content) strsplit(without_comments, "\r?\n")[[1]] } cpp_attribute_pattern <- function(is_attribute) { paste0( "^[[:blank:]]*", ## allow for indentation if (!is_attribute) "//[[:blank:]]*", ## the comment should be started by //, with potential spaces following "\\[\\[", ## the opening square brackets "[[:space:]]*(.*?)[[:space:]]*", ## the material within "\\]\\]", ## closing brackets "[[:space:]]*" ## trailing spaces ) } #' Parse a C++ function #' #' Parses a C++ function returning a tibble with the function name and return #' type and a list column with the arguments of the function. #' @inheritParams cpp_decorations #' @param context The function context, as obtained by the `context` column from [cpp_decorations()] #' @return A tibble with the following fields: #' - name - The name of the function #' - return_type - The return type of the function #' - args - A list column containing a tibble of the functions arguments #' - type - The type of the argument #' - name - The name of the argument #' - default - The default value of the argument (if any). #' @export #' @examples #' # Setup #' context <- "int fun(int x) { return x + 1; }" #' #' # Parse the function #' parse_cpp_function(context) parse_cpp_function <- function(context, is_attribute = FALSE) { if (length(context) == 0 || !nzchar(context[[1L]])) { return( tibble( name = character(), return_type = character(), args = list( tibble( type = character(), name = character(), default = character() ) ) ) ) } # Remove the decoration line if it exists context <- grep(paste0(cpp_attribute_pattern(is_attribute), "$"), context, value = TRUE, invert = TRUE) if (is_attribute) { # non-comment attributes may also be on the first line, they need to be removed context <- sub(cpp_attribute_pattern(is_attribute), "", context) } first_brace_or_statement <- grep("[{;]", context)[[1L]] # remove // comments from context context <- sub("//.*", "", context[seq(1L, first_brace_or_statement)]) # If not a first brace assume it is just a declaration. signature <- sub("[[:space:]]*[{].*$", "", paste(context, collapse = " ")) out <- .Call(decor_parse_cpp_function, signature) if (is.character(out)) stop(out) out } decor/NEWS.md0000644000176200001440000000121314446510270012444 0ustar liggesusers# decor 1.0.2 * Davis Vaughan is now the maintainer. * `cpp_files()` now always returns file paths sorted according to the C locale. This prevents nuisance changes in files automatically generated by downstream tools, such as `cpp11::cpp_register()`, due to differences in the ambient locale (#13, @jennybc). * `parse_cpp_function()` strips `//` comments (#8), supports spaces before the argument list (#4) and handles ref/deref (#6, @nbenn). # decor 1.0.1 * Romain François is now the maintainer. * `cpp_decoration(is_attribute = TRUE)` now automatically ignores all decoration inside comments (#3) # decor 1.0.0 * Initial release decor/MD50000644000176200001440000000154214450070252011657 0ustar liggesusers6778192267b084878fb67075d796a688 *DESCRIPTION fb63bee874b625564e29f34b844c842f *LICENSE a9a3a8cd0f5cc59e5e3add1b5d2a845e *NAMESPACE 778ff0934f47c8496a9b712c45146e14 *NEWS.md 611329ef821e2f94fc9bb4a90d5d2327 *R/decor.R f5f985ed66530f44f4d126d522773902 *R/zzz.R b38eb7194aa76bb087d3e01154db3433 *README.md 957539e398945a3d1eb6b7967ef03a27 *man/cpp_decorations.Rd 0931e0a3df1bd0d7c912847fb1c1680b *man/cpp_files.Rd 386a53e372524c72b39fa9698f237fc4 *man/parse_cpp_function.Rd 07e19acfd7e7d1e7b6aad0a6c6e83d42 *src/blank_comments.cpp ae1e573f84d62dedf15597914e2ec143 *src/init.c bf8ce754f45ef78c0024bc209d923830 *src/parse_cpp_function.cpp 7df727e95715beaab86d80051ee5aae0 *tests/testthat.R bb0a3a44c73fb805ef18a63078863c85 *tests/testthat/helper.R c3c24cff85b6973eed47779502f105ff *tests/testthat/test-decor.R de701a5d1b76ba32f3978de6f10192a2 *tests/testthat/test-zzz.R