C rewrite

.gitignore

@@ -0,0 +1,16 @@
+# Compiled object code
+src/*.o
+src/*.so
+src/*.dll
+src/*.dylib
+src/symbols.rds
+
+# R CMD build / check artifacts
+*.tar.gz
+*.Rcheck/
+
+# Editor / IDE
+.Rproj.user/
+.Rhistory
+.RData
+.Ruserdata

Makefile

@@ -1,13 +1,32 @@
 R = R
 RSCRIPT = Rscript
 
-.PHONY: install test clean
+# Library holding the corpus packages installed WITH srcref retention, used by
+# the FULL_TEST whole-package tests. Prepended to .libPaths() for `test-full`
+# and `corpus-install`. Override with: make test-full CORPUS_LIB=/path/to/lib
+CORPUS_LIB ?= $(HOME)/Rlib_test
+
+# Packages exercised by the corpus tests (must be installed with srcref).
+CORPUS_PKGS = 'data.table','dplyr','fs','ggplot2','glue','jsonlite','stringr','zoo'
+
+.PHONY: install test test-full corpus-install clean
 
 install:
 	$(R) CMD INSTALL .
 
+# Fast suite: blacklist + snapshot tests. Corpus tests skip (no FULL_TEST).
 test:
 	$(RSCRIPT) -e "testthat::test_dir('tests/testthat', load_package = 'source')"
 
+# Full suite including the slow whole-package corpus tests. Requires the corpus
+# installed with srcref retention (run `make corpus-install` once first).
+test-full:
+	FULL_TEST=1 $(RSCRIPT) -e ".libPaths(c('$(CORPUS_LIB)', .libPaths())); testthat::test_dir('tests/testthat', load_package = 'source')"
+
+# Install the corpus packages from source with srcref retained into CORPUS_LIB.
+corpus-install:
+	mkdir -p "$(CORPUS_LIB)"
+	$(RSCRIPT) -e ".libPaths(c('$(CORPUS_LIB)', .libPaths())); install.packages(c($(CORPUS_PKGS)), lib='$(CORPUS_LIB)', INSTALL_opts='--with-keep.source', type='source', dependencies=c('Depends','Imports','LinkingTo'))"
+
 clean:
 	rm -rf *.tar.gz *.Rcheck

NAMESPACE

@@ -6,3 +6,4 @@ export(impute_srcrefs)
 export(reset_impute_blacklist)
 export(set_impute_blacklist)
 export(source_impute_srcrefs)
+useDynLib(imputesrcref, .registration = TRUE)

R/blacklist_api.R

@@ -1,102 +1,44 @@
-blacklist_option_name <- "imputesrcref.wrap_arg_blacklist"
-
-specialsxp_builtin_names <- local({
-  nms <- builtins()
-  out <- nms[vapply(nms, function(nm) {
-    obj <- get(nm, envir = baseenv(), inherits = FALSE)
-    is.primitive(obj) && identical(typeof(obj), "special")
-  }, logical(1))]
-  sort(unique(out))
-})
-
-normalize_blacklist_names <- function(functions, arg = "functions") {
-  if (is.null(functions)) {
-    return(character())
-  }
-  if (!is.character(functions)) {
-    stop(sprintf("`%s` must be NULL or a character vector", arg), call. = FALSE)
-  }
-
-  out <- trimws(functions)
-  out <- out[!is.na(out) & nzchar(out)]
-  sort(unique(out))
-}
-
-user_blacklist_names <- function() {
-  normalize_blacklist_names(getOption(blacklist_option_name, NULL), arg = blacklist_option_name)
-}
-
-# rlang NSE functions that capture their argument as an unevaluated expression
-# rather than evaluating it. Wrapping their arguments in transparent braces
-# changes what expression is captured, breaking downstream DSL evaluators such
-# as tidyselect (e.g. `expr({c(x)})` captures `{c(x)}` instead of `c(x)` and
-# `tidyselect::eval_select` then fails to resolve the column `x`).
-rlang_nse_names <- c(
-  "expr", "quo", "quos",
-  "enquo", "enquos", "enexpr", "enexprs"
-)
-
-effective_blacklist_names <- function() {
-  sort(unique(c(specialsxp_builtin_names, rlang_nse_names, user_blacklist_names())))
-}
-
-#' Get call names blacklisted from generic argument wrapping.
+#' Manage call blacklist for generic argument wrapping
 #'
 #' By default, [impute_srcrefs()] skips argument wrapping for primitive
-#' `SPECIALSXP` calls discovered from [builtins()]. This getter can return only
-#' user-configured entries, or the effective blacklist including defaults.
+#' `SPECIALSXP` calls discovered from [builtins()]. These functions inspect and
+#' modify the user-configured portion of that blacklist.
+#'
+#' - `get_impute_blacklist()` returns the blacklist, optionally including the
+#'   built-in defaults.
+#' - `set_impute_blacklist()` adds or replaces user entries, stored in
+#'   `options(imputesrcref.wrap_arg_blacklist = ...)`.
+#' - `reset_impute_blacklist()` clears user entries.
 #'
 #' @param include_default If `TRUE`, include built-in `SPECIALSXP` names.
+#' @param functions Character vector of call names. `NULL` clears user entries.
+#' @param append If `TRUE` append to existing user entries; otherwise replace.
 #'
-#' @return A sorted unique character vector of call names.
+#' @return
+#' `get_impute_blacklist()` returns a sorted unique character vector of call
+#' names. `set_impute_blacklist()` invisibly returns the current
+#' user-configured entries. `reset_impute_blacklist()` invisibly returns an
+#' empty character vector.
 #'
 #' @examples
 #' head(get_impute_blacklist())
 #' set_impute_blacklist(c("str_c", "paste"))
 #' get_impute_blacklist(include_default = FALSE)
 #' reset_impute_blacklist()
+#' @rdname impute_blacklist
 #' @export
 get_impute_blacklist <- function(include_default = TRUE) {
-  if (!is.logical(include_default) || length(include_default) != 1L || is.na(include_default)) {
-    stop("`include_default` must be TRUE or FALSE", call. = FALSE)
-  }
-
-  if (isTRUE(include_default)) {
-    return(effective_blacklist_names())
-  }
-
-  user_blacklist_names()
+  .Call(C_get_impute_blacklist, include_default)
 }
 
-#' Set user call names blacklisted from generic argument wrapping.
-#'
-#' User entries are stored in `options(imputesrcref.wrap_arg_blacklist = ...)`.
-#'
-#' @param functions Character vector of call names. `NULL` clears user entries.
-#' @param append If `TRUE` append to existing user entries; otherwise replace.
-#'
-#' @return Invisibly returns current user-configured blacklist entries.
+#' @rdname impute_blacklist
 #' @export
 set_impute_blacklist <- function(functions, append = TRUE) {
-  if (!is.logical(append) || length(append) != 1L || is.na(append)) {
-    stop("`append` must be TRUE or FALSE", call. = FALSE)
-  }
-
-  incoming <- normalize_blacklist_names(functions, arg = "functions")
-  current <- if (isTRUE(append)) user_blacklist_names() else character()
-  next_values <- sort(unique(c(current, incoming)))
-
-  options(imputesrcref.wrap_arg_blacklist = next_values)
-  invisible(next_values)
+  invisible(.Call(C_set_impute_blacklist, functions, append))
 }
 
-#' Reset user call names blacklisted from generic argument wrapping.
-#'
-#' Clears user entries configured via [set_impute_blacklist()].
-#'
-#' @return Invisibly returns an empty character vector.
+#' @rdname impute_blacklist
 #' @export
 reset_impute_blacklist <- function() {
-  options(imputesrcref.wrap_arg_blacklist = NULL)
-  invisible(character())
+  invisible(.Call(C_reset_impute_blacklist))
 }