conditionally use features from CXX standard > 11 if available - REQUIRES PATCHED TESTHAT FOR CXX23

Author: pachadotdev

.Rbuildignore

@@ -32,3 +32,7 @@
 ^Rcppsampling$
 ^cpp11sampling$
 ^cpp4rsampling$
+^scripts$
+^cpp4rbenchmark$
+^cpp4rtest-check\.log$
+.*\.tar\.gz$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cpp4r
 Title: Header-Only 'C++' and 'R' Interface
-Version: 0.3.1
+Version: 0.4.0
 Authors@R: c(
     person("Mauricio", "Vargas Sepulveda", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-1017-7574")),

Makefile

@@ -1,23 +1,36 @@
 clean:
 	@Rscript -e 'devtools::clean_dll("cpp4rtest"); cpp4r::register("cpp4rtest")'
 
+install:
+	@Rscript -e 'devtools::clean_dll("cpp4rtest"); devtools::install()'
+
+docs:
+	@Rscript -e 'devtools::document(); pkgsite::build_site()'
+
 test:
+	@clear
+	@echo "==============================="
 	@echo "Testing R code"
 	@Rscript -e 'devtools::document(); devtools::test(); devtools::install()'
-	@echo "Testing C++ code"
-	@Rscript -e 'devtools::clean_dll("cpp4rtest"); devtools::load_all("cpp4rtest"); devtools::test("cpp4rtest")'
+	@echo "==============================="
+	@/bin/bash -euo pipefail -c './scripts/test_loop.sh'
+
+bench:
+	@clear
+	@Rscript -e 'devtools::install()'
+	@clear
+	@/bin/bash -euo pipefail -c './scripts/bench_loop.sh'
 
 check:
+	@clear
+	@echo "==============================="
 	@echo "Checking R code"
-	@Rscript -e 'devtools::install(); devtools::check()'
+	@Rscript -e 'devtools::install(); devtools::check(error_on = "error")'
+	@clear
+	@echo "==============================="
 	@echo "Checking C++ code"
-	@Rscript -e 'devtools::check("cpp4rtest")'
-	
-site:
-	@Rscript -e 'devtools::document(); pkgdown::build_site()'
-
-install:
-	@Rscript -e 'devtools::clean_dll("cpp4rtest"); devtools::install()'
+	@/bin/bash -euo pipefail -c './scripts/check_loop.sh'
+	@echo "==============================="
 
 clang_format=`which clang-format-18`
 

NEWS.md

@@ -1,3 +1,8 @@
+# cpp4r 0.4.0
+
+* Clearer documentation about the C++ workflow (i.e., how to use anticonf to specify a C++ standard)
+* Allows for default values like `my_fun(int x = 100)` to call `my_fun()` with the same result as `my_fun(100L)` from R
+
 # cpp4r 0.3.1
 
 * Added support for implicit conversions for R lists

R/register.R

@@ -89,9 +89,6 @@ register <- function(path = NULL, quiet = !is_interactive(), extension = c(".cpp
   cpp_function_registration <- glue::glue_collapse(cpp_function_registration, sep = "\n")
 
   extra_includes <- character()
-  if (pkg_links_to_rcpp(path)) {
-    extra_includes <- c(extra_includes, "#include <cpp4r/R.hpp>", "#include <Rcpp.h>", "using namespace Rcpp;")
-  }
 
   pkg_types <- c(
     file.path(path, "src", paste0(package, "_types.h")),
@@ -230,8 +227,60 @@ generate_r_functions <- function(funs, package = "cpp4r", use_package = FALSE) {
   }
 
   funs$package_call <- package_call
-  funs$list_params <- vcapply(funs$args, glue_collapse_data, "{name}")
-  funs$params <- vcapply(funs$list_params, function(x) if (nzchar(x)) paste0(", ", x) else x)
+  
+  # Extract default values and create parameter lists
+  funs$param_info <- lapply(funs$args, function(args_df) {
+    if (nrow(args_df) == 0) {
+      return(list(params = "", args = "", checks = ""))
+    }
+    
+    # Parse default values from the type column (they appear after '=')
+    param_names <- args_df$name
+    param_types <- args_df$type
+    
+    # Extract defaults (format: "type name = value" becomes "value")
+    defaults <- vapply(param_types, function(t) {
+      if (grepl("=", t)) {
+        sub(".*=\\s*", "", t)
+      } else {
+        ""
+      }
+    }, character(1))
+    
+    # Clean up types (remove default value parts)
+    clean_types <- vapply(param_types, function(t) {
+      trimws(sub("\\s*=.*$", "", t))
+    }, character(1))
+    
+    # Generate R function parameters with defaults
+    params_with_defaults <- vapply(seq_along(param_names), function(i) {
+      if (nzchar(defaults[i])) {
+        # Convert C++ defaults to R defaults
+        r_default <- convert_cpp_default_to_r(defaults[i])
+        paste0(param_names[i], " = ", r_default)
+      } else {
+        param_names[i]
+      }
+    }, character(1))
+    
+    # Generate type checking/coercion code
+    checks <- vapply(seq_along(param_names), function(i) {
+      generate_type_check(param_names[i], clean_types[i])
+    }, character(1))
+    checks <- checks[nzchar(checks)]
+    
+    list(
+      params = paste(params_with_defaults, collapse = ", "),
+      args = paste(param_names, collapse = ", "),
+      checks = if (length(checks) > 0) paste0("\t", checks, collapse = "\n") else ""
+    )
+  })
+  
+  funs$list_params <- vapply(funs$param_info, function(x) x$params, character(1))
+  funs$call_args <- vapply(funs$param_info, function(x) x$args, character(1))
+  funs$type_checks <- vapply(funs$param_info, function(x) x$checks, character(1))
+  
+  funs$params <- vcapply(funs$call_args, function(x) if (nzchar(x)) paste0(", ", x) else x)
   is_void <- funs$return_type == "void"
   funs$calls <- ifelse(is_void,
     glue::glue_data(funs, "invisible(.Call({package_names}{params}{package_call}))"),
@@ -256,20 +305,89 @@ generate_r_functions <- function(funs, package = "cpp4r", use_package = FALSE) {
     }
   }, funs$file, funs$line, SIMPLIFY = TRUE)
 
-  # Generate R functions with or without Roxygen comments
-  out <- mapply(function(name, list_params, calls, roxygen_comment) {
+  # Generate R functions with type checks and defaults
+  out <- mapply(function(name, list_params, calls, roxygen_comment, type_checks) {
+    body <- if (nzchar(type_checks)) {
+      paste0("\n", type_checks, "\n\t", calls, "\n")
+    } else {
+      paste0("\n\t", calls, "\n")
+    }
+    
     if (nzchar(roxygen_comment)) {
-      glue::glue("{roxygen_comment}\n{name} <- function({list_params}) {{\n\t{calls}\n}}")
+      glue::glue("{roxygen_comment}\n{name} <- function({list_params}) {{{body}}}")
     } else {
-      glue::glue("{name} <- function({list_params}) {{\n  {calls}\n}}")
+      glue::glue("{name} <- function({list_params}) {{{body}}}")
     }
-  }, funs$name, funs$list_params, funs$calls, funs$roxygen_comment, SIMPLIFY = TRUE)
+  }, funs$name, funs$list_params, funs$calls, funs$roxygen_comment, funs$type_checks, SIMPLIFY = TRUE)
 
   out <- glue::trim(out)
   out <- glue::glue_collapse(out, sep = "\n\n")
   unclass(out)
 }
 
+# Helper function to convert C++ default values to R
+convert_cpp_default_to_r <- function(cpp_default) {
+  cpp_default <- trimws(cpp_default)
+  
+  # Handle common cases
+  if (cpp_default == "true" || cpp_default == "TRUE") {
+    return("TRUE")
+  } else if (cpp_default == "false" || cpp_default == "FALSE") {
+    return("FALSE")
+  } else if (grepl("^[0-9]+L?$", cpp_default)) {
+    # Integer literal
+    return(paste0(sub("L$", "", cpp_default), "L"))
+  } else if (grepl("^[0-9.]+[fF]?$", cpp_default)) {
+    # Float/double literal
+    return(sub("[fF]$", "", cpp_default))
+  } else if (grepl('^".*"$', cpp_default) || grepl("^'.*'$", cpp_default)) {
+    # String literal - keep as is
+    return(cpp_default)
+  } else if (cpp_default == "NULL" || cpp_default == "nullptr") {
+    return("NULL")
+  }
+  
+  # Default: keep as-is and hope for the best
+  cpp_default
+}
+
+# Helper function to generate type checking/coercion code
+generate_type_check <- function(param_name, param_type) {
+  # Map C++ types to R coercion functions
+  if (param_type == "int" || grepl("^int[[:space:]]*$", param_type)) {
+    return(glue::glue("{param_name} <- as.integer({param_name})"))
+  } else if (param_type == "double" || grepl("^double[[:space:]]*$", param_type)) {
+    return(glue::glue("{param_name} <- as.numeric({param_name})"))
+  } else if (param_type == "bool" || grepl("^bool[[:space:]]*$", param_type)) {
+    return(glue::glue("{param_name} <- as.logical({param_name})"))
+  } else if (grepl("string", param_type, ignore.case = TRUE)) {
+    return(glue::glue("{param_name} <- as.character({param_name})"))
+  }
+  
+  # Handle cpp4r matrix types - set proper storage mode
+  if (grepl("integers_matrix", param_type)) {
+    return(glue::glue("storage.mode({param_name}) <- \"integer\""))
+  } else if (grepl("doubles_matrix", param_type)) {
+    return(glue::glue("storage.mode({param_name}) <- \"double\""))
+  } else if (grepl("logicals_matrix", param_type)) {
+    return(glue::glue("storage.mode({param_name}) <- \"logical\""))
+  }
+  
+  # Handle cpp4r vector types - set proper storage mode as well
+  if (grepl("^integers[^_]", param_type) || param_type == "integers") {
+    return(glue::glue("storage.mode({param_name}) <- \"integer\""))
+  } else if (grepl("^doubles[^_]", param_type) || param_type == "doubles") {
+    return(glue::glue("storage.mode({param_name}) <- \"double\""))
+  } else if (grepl("^logicals[^_]", param_type) || param_type == "logicals") {
+    return(glue::glue("storage.mode({param_name}) <- \"logical\""))
+  } else if (grepl("^strings[^_]", param_type) || param_type == "strings") {
+    return(glue::glue("storage.mode({param_name}) <- \"character\""))
+  }
+  
+  # For other cpp4r types, don't add checks (they handle conversion internally)
+  return("")
+}
+
 extract_roxygen_comments <- function(file) {
   lines <- readLines(file)
 
@@ -356,12 +474,6 @@ get_call_entries <- function(path, names, package) {
   res[seq(mid, end)]
 }
 
-pkg_links_to_rcpp <- function(path) {
-  deps <- desc::desc_get_deps(file.path(path, "DESCRIPTION"))
-
-  any(deps$type == "LinkingTo" & deps$package == "Rcpp")
-}
-
 get_register_needs <- function() {
   res <- read.dcf(system.file("DESCRIPTION", package = "cpp4r"))[, "Config/Needs/cpp4r/register"]
   strsplit(res, "[[:space:]]*,[[:space:]]*")[[1]]

R/vendor.R

@@ -12,13 +12,14 @@
 #' **you**. Bugfixes and new features in cpp4r will not be available for your
 #' code until you run `cpp_vendor()` again.
 #'
-#' @param path The directory to vendor the headers into
+#' @param path The directory with the vendored headers. It is recommended to use `"./src/vendor"`.
+#' The default is `NULL`.
 #' @return The path to the vendored code (invisibly).
 #' @export
 #' @examples
 #' # create a new directory
 #' dir <- paste0(tempdir(), "/", gsub("\\s+|[[:punct:]]", "", Sys.time()))
-#' dir.create(dir, recursive = TRUE)
+#' dir.create(dir, recursive = TRUE, showWarnings = FALSE)
 #'
 #' # vendor the cpp4r headers into the directory
 #' vendor(dir)
@@ -27,7 +28,7 @@
 #'
 #' # cleanup
 #' unlink(dir, recursive = TRUE)
-vendor <- function(path = "./src/vendor") {
+vendor <- function(path = NULL) {
   if (is.null(path)) {
     stop("You must provide a path to vendor the code into", call. = FALSE)
   }

README.Rmd

@@ -13,7 +13,7 @@ knitr::opts_chunk$set(
 )
 ```
 
-# cpp4r
+# cpp4r: Header-Only 'C++' and 'R' Interface
 
 <!-- badges: start -->
 [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable)
@@ -32,6 +32,9 @@ compilation for code snippets.
 cpp4r can be used as a replacement for cpp11 in existing or new packages. Think of cpp11 and cpp4r as MySQL and MariaDB:
 they are almost identical, but cpp4r has some extra features.
 
+cpp4r requires at least C++11. It is compatible with C++14, C++17, C++20, C++23 as well. The headers are written in
+a way that is compatible with all of these standards and newer features are used if the compiler supports them.
+
 After discussing some [pull requests](https://github.com/pachadotdev/cpp11/pulls/pachadotdev) with Hadley Wickham from
 Posit, it was mentioned that I should create my own fork to add the following features:
 

cpp4rsampling/DESCRIPTION

@@ -15,9 +15,10 @@ Description: ADD DESCRIPTION. TWO OR MORE LINES
 License: Apache License (>= 2)
 BugReports: https://github.com/USERNAME/PKGNAME/issues
 URL: https://WEBSITE.COM
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
 Encoding: UTF-8
 NeedsCompilation: yes
 VignetteBuilder: knitr
 LinkingTo: cpp4r
 Config/testthat/edition: 3
+SystemsRequirements: C++NN