scripts/r-api-report.R
Rama main · réplica de lectura del repositorio original.
#!/usr/bin/env Rscript
#
# r-api-report.R
#
# Reports which R C API symbols used by RStudio are not part of R's public API.
#
# The public API is determined by @apifun, @eapifun, @apivar, and @eapivar
# annotations in R-exts.texi. The embedding API (@embfun, @embvar) and
# formerly-API symbols (@forfun) are reported separately.
#
# Fetches the latest R-exts.texi and R headers from
# https://github.com/r-devel/r-svn (trunk branch).
#
# Usage:
# Rscript scripts/r-api-report.R
# -- Paths ----
this_script <- sub("--file=", "", grep("--file=", commandArgs(FALSE), value = TRUE))
rstudio_root <- normalizePath(file.path(dirname(this_script), ".."))
rstudio_cpp <- file.path(rstudio_root, "src", "cpp")
stopifnot(dir.exists(rstudio_cpp))
outfile <- file.path(rstudio_root, "scripts", "r-api-report.txt")
# -- Step 0: Clone or update r-devel/r-svn ----
r_svn_repo <- "https://github.com/r-devel/r-svn.git"
r_svn_cache <- file.path(Sys.getenv("HOME"), ".cache", "rstudio", "r-svn")
if (dir.exists(file.path(r_svn_cache, ".git"))) {
message("Updating r-devel/r-svn cache...")
system2("git", c("-C", r_svn_cache, "fetch", "--depth=1", "origin", "trunk"))
system2("git", c("-C", r_svn_cache, "checkout", "FETCH_HEAD", "--", "doc/manual", "src/include"))
} else {
message("Cloning r-devel/r-svn (sparse, shallow)...")
dir.create(dirname(r_svn_cache), recursive = TRUE, showWarnings = FALSE)
system2("git", c("clone", "--depth=1", "--filter=blob:none", "--sparse", r_svn_repo, r_svn_cache))
system2("git", c("-C", r_svn_cache, "sparse-checkout", "set", "doc/manual", "src/include"))
}
texi_path <- file.path(r_svn_cache, "doc", "manual", "R-exts.texi")
r_include <- file.path(r_svn_cache, "src", "include")
stopifnot(file.exists(texi_path))
texi <- readLines(texi_path)
# -- Step 1: Extract API symbols from R-exts.texi ----
extract_texi_symbols <- function(tags) {
pattern <- paste0("@(", paste(tags, collapse = "|"), ") ([A-Za-z_][A-Za-z0-9_]*)")
m <- regmatches(texi, regexec(pattern, texi))
unique(vapply(m[lengths(m) > 0], `[[`, character(1), 3))
}
public_api <- extract_texi_symbols(c("apifun", "eapifun", "apivar", "eapivar"))
# Treat symbols exported by graphics headers as public API
for (gfx_header in c("R_ext/GraphicsEngine.h", "R_ext/GraphicsDevice.h")) {
path <- file.path(r_include, gfx_header)
if (file.exists(path)) {
lines <- readLines(path)
m <- regmatches(lines, gregexpr("\\b(R_|Rf_|GE)[A-Za-z_][A-Za-z0-9_]*", lines))
public_api <- unique(c(public_api, unlist(m)))
}
}
embed_api <- extract_texi_symbols(c("embfun", "embvar"))
embed_extras <- c(
"Rf_initialize_R", "Rf_mainloop", "R_Suicide", "R_Consolefile", "R_Outputfile",
"R_CStackStart", "R_running_as_main_program", "R_DirtyImage", "R_HomeDir",
"R_Quiet", "R_NoEcho", "R_Verbose", "R_SignalHandlers",
"R_SaveGlobalEnvToFile", "R_RestoreGlobalEnvFromFile"
)
embed_api <- unique(c(embed_api, embed_extras))
former_api <- extract_texi_symbols("forfun")
# -- Step 2: Extract R C API symbols used by RStudio ----
# Scan source files (excluding RInternal.hpp, RRuntime.cpp, and binary files)
source_files <- list.files(
rstudio_cpp,
pattern = "\\.(c|cc|cpp|h|hpp|mm)$",
recursive = TRUE,
full.names = TRUE
)
source_files <- source_files[!grepl("RInternal\\.hpp$|RRuntime\\.cpp$", source_files)]
all_source <- unlist(lapply(source_files, readLines, warn = FALSE))
extract_matches <- function(pattern) {
m <- regmatches(all_source, gregexpr(pattern, all_source, perl = TRUE))
unique(unlist(m))
}
rf_symbols <- extract_matches("\\bRf_[a-zA-Z_][a-zA-Z0-9_]*")
r_symbols <- extract_matches("\\bR_[a-zA-Z][a-zA-Z0-9_]*")
r_macros <- c(
"ALTREP", "ATTRIB", "BODY", "CAAR", "CADR", "CADDR", "CADDDR", "CAD4R",
"CAD5R", "CAR", "CDAR", "CDDDR", "CDDR", "CDR", "CHAR", "CLEAR_ATTRIB",
"CLOENV", "COMPLEX", "COMPLEX_ELT", "DATAPTR", "DATAPTR_OR_NULL",
"DATAPTR_RO", "DUPLICATE_ATTRIB", "ENCLOS", "FORMALS", "FRAME", "HASHTAB",
"INTEGER", "INTEGER_ELT", "INTERNAL", "IS_SCALAR", "IS_SIMPLE_SCALAR",
"LENGTH", "LEVELS", "LOGICAL", "LOGICAL_ELT", "MARK_NOT_MUTABLE", "MISSING",
"NAMED", "OBJECT", "PRCODE", "PRENV", "PRINTNAME", "PROTECT",
"PROTECT_WITH_INDEX", "PRVALUE", "RAW", "RAW_ELT", "REAL", "REAL_ELT",
"REAL_RO", "INTEGER_RO", "LOGICAL_RO", "COMPLEX_RO", "RAW_RO", "SETCAR",
"SETCDR", "SETCADR", "SETCADDR", "SETCADDDR", "SETCAD4R", "SETLEVELS",
"SET_ATTRIB", "SET_COMPLEX_ELT", "SET_INTEGER_ELT", "SET_LOGICAL_ELT",
"SET_MISSING", "SET_NAMED", "SET_RAW_ELT", "SET_REAL_ELT", "SET_S4_OBJECT",
"SET_STRING_ELT", "SET_TAG", "SET_TYPEOF", "SET_VECTOR_ELT",
"SHALLOW_DUPLICATE_ATTRIB", "STRING_ELT", "SYMVALUE", "TAG", "TYPEOF",
"UNPROTECT", "VECTOR_ELT", "XLENGTH"
)
macro_pattern <- paste0("\\b(", paste(r_macros, collapse = "|"), ")\\s*\\(")
macro_matches <- regmatches(all_source, gregexpr(macro_pattern, all_source, perl = TRUE))
macro_matches <- unique(trimws(gsub("\\($", "", unlist(macro_matches))))
all_symbols <- unique(c(rf_symbols, r_symbols, macro_matches))
# Filter R_/Rf_ symbols to only those that appear in R's headers
r_header_files <- list.files(r_include, pattern = "\\.h$", recursive = TRUE, full.names = TRUE)
r_header_content <- paste(unlist(lapply(r_header_files, readLines, warn = FALSE)), collapse = "\n")
all_symbols <- Filter(function(sym) {
if (grepl("^(R_|Rf_)", sym)) {
grepl(paste0("\\b", sym, "\\b"), r_header_content, perl = TRUE)
} else {
TRUE
}
}, all_symbols)
# Remove types, header guards, preprocessor macros
type_excludes <- c(
"R_xlen_t", "R_SIZE_T", "R_ARCH", "R_HOME", "R_ext", "R_INTERFACE_PTRS",
"R_INTERNALS_H_", "R_NO_REMAP", "R_USE_PROTOTYPES", "R_USE_SIGNALS",
"SEXP", "R_CFinalizer_t", "R_CallMethodDef", "R_ObjectTable",
"R_INCLUDE_", "R_LEN_T", "R_INLINE"
)
all_symbols <- setdiff(all_symbols, type_excludes)
# -- Step 3: Classify each symbol ----
classify <- function(sym) {
short <- sub("^Rf_", "", sym)
if (sym %in% public_api || short %in% public_api) return("public")
if (sym %in% embed_api || short %in% embed_api) return("embed")
if (sym %in% former_api || short %in% former_api) return("former")
"nonapi"
}
classes <- vapply(all_symbols, classify, character(1))
result <- split(names(classes), classes)
for (cls in c("public", "embed", "former", "nonapi")) {
if (is.null(result[[cls]])) result[[cls]] <- character(0)
}
# -- Step 4: Count uses for display ----
count_uses <- function(sym) {
pattern <- paste0("\\b", sym, "\\b")
matches <- grep(pattern, all_source, perl = TRUE, value = TRUE)
# exclude comment-only lines
matches <- matches[!grepl("^\\s*//", matches)]
matches <- matches[!grepl("^\\s*\\*", matches)]
length(matches)
}
# -- Step 5: Write report ----
out <- character()
ln <- function(...) out <<- c(out, paste0(...))
ln("R API Compliance Report")
ln("============================================================")
ln("")
ln("Generated: ", format(Sys.Date()))
ln("Source: ", r_svn_repo, " (trunk)")
ln("Scanned: src/cpp/ (excluding RInternal.hpp, RRuntime.cpp)")
ln("")
ln("Public API symbols used: ", length(result$public))
ln("Embedding API symbols used: ", length(result$embed))
if (length(result$former) > 0) {
ln("Former API symbols used: ", length(result$former))
}
ln("Non-API symbols used: ", length(result$nonapi))
ln("")
write_symbol_table <- function(symbols, header, subtitle = NULL) {
if (length(symbols) == 0) return()
ln(header)
ln("------------------------------------------------------------")
if (!is.null(subtitle)) ln(subtitle)
ln("")
ln(sprintf("%-35s %s", "Symbol", "Uses"))
ln(sprintf("%-35s %s", "------", "----"))
counts <- vapply(sort(symbols), count_uses, integer(1))
for (sym in names(counts[counts > 0])) {
ln(sprintf("%-35s %d", sym, counts[[sym]]))
}
ln("")
}
write_symbol_table(result$nonapi, "Non-Public API Symbols")
write_symbol_table(
result$embed,
"Embedding API Symbols",
"(Documented in the \"Embedding R\" chapter, separate from public C API)"
)
if (length(result$former) > 0) {
ln("Former API Symbols")
ln("------------------------------------------------------------")
ln("")
for (sym in sort(result$former)) ln(" ", sym)
ln("")
}
writeLines(out, outfile)
message("Report written to ", outfile)
message("")
writeLines(readLines(outfile))