Cache compiler configuration probes

Author: t-kalinowski

R/aaa-utils.R

@@ -54,11 +54,30 @@ quickr_r_cmd <- function(
   r_cmd
 }
 
+quickr_compiler_probe_cache <- new.env(parent = emptyenv())
+
+quickr_cached_r_cmd_config_value <- function(
+  name,
+  cache = quickr_compiler_probe_cache
+) {
+  stopifnot(is_string(name), is.environment(cache))
+
+  cached <- get0(name, envir = cache, inherits = FALSE, ifnotfound = NULL)
+  if (is.null(cached)) {
+    cached <- quickr_r_cmd_config_value(name)
+    assign(name, cached, envir = cache)
+  }
+
+  cached
+}
+
 quickr_r_cmd_config_value <- function(
   name,
   r_cmd = quickr_r_cmd(),
   system2 = base::system2
 ) {
+  stopifnot(is_string(name), is_string(r_cmd))
+
   out <- tryCatch(
     suppressWarnings(system2(
       r_cmd,
@@ -74,8 +93,9 @@ quickr_r_cmd_config_value <- function(
   }
   value <- trimws(paste(out, collapse = " "))
   if (!nzchar(value) || grepl("^ERROR:", value)) {
-    return("")
+    value <- ""
   }
+
   value
 }
 

R/compiler.R

@@ -15,6 +15,15 @@ quickr_flang_available <- function(
   system2 = base::system2
 ) {
   flang <- quickr_flang_path(which = which)
+  quickr_flang_available_at_path(flang, system2 = system2)
+}
+
+quickr_flang_available_at_path <- function(
+  flang,
+  system2 = base::system2
+) {
+  stopifnot(is_string(flang), is.function(system2))
+
   if (!nzchar(flang)) {
     return(list(path = "", available = FALSE))
   }
@@ -28,6 +37,28 @@ quickr_flang_available <- function(
   list(path = flang, available = TRUE)
 }
 
+quickr_cached_flang_available <- function(
+  which = Sys.which,
+  system2 = base::system2,
+  cache = quickr_compiler_probe_cache
+) {
+  stopifnot(is.function(which), is.function(system2), is.environment(cache))
+
+  flang <- quickr_flang_path(which = which)
+  if (!identical(system2, base::system2)) {
+    return(quickr_flang_available_at_path(flang, system2 = system2))
+  }
+
+  cache_key <- paste("flang_available", flang, sep = "\r")
+  cached <- get0(cache_key, envir = cache, inherits = FALSE, ifnotfound = NULL)
+  if (is.null(cached)) {
+    cached <- quickr_flang_available_at_path(flang)
+    assign(cache_key, cached, envir = cache)
+  }
+
+  cached
+}
+
 quickr_flang_state <- local({
   state <- new.env(parent = emptyenv())
   state$auto_disabled <- FALSE
@@ -164,15 +195,15 @@ quickr_prefer_flang <- function(
 
   # Best-effort: on macOS, prefer flang if it is available.
   if (sysname == "Darwin") {
-    info <- quickr_flang_available(which = which, system2 = system2)
+    info <- quickr_cached_flang_available(which = which, system2 = system2)
     return(isTRUE(info$available))
   }
 
   FALSE
 }
 
 quickr_default_fortran_makevars_lines <- function(
-  config_value = quickr_r_cmd_config_value
+  config_value = quickr_cached_r_cmd_config_value
 ) {
   fc <- trimws(config_value("FC"))
   if (!nzchar(fc)) {
@@ -200,7 +231,7 @@ quickr_fcompiler_env <- function(
   sysname = Sys.info()[["sysname"]],
   use_openmp = FALSE,
   link_flags = character(),
-  config_value = quickr_r_cmd_config_value
+  config_value = quickr_cached_r_cmd_config_value
 ) {
   stopifnot(is.character(build_dir), length(build_dir) == 1L, nzchar(build_dir))
 
@@ -217,7 +248,10 @@ quickr_fcompiler_env <- function(
     system2 = system2
   ))
   if (use_flang) {
-    flang_info <- quickr_flang_available(which = which, system2 = system2)
+    flang_info <- quickr_cached_flang_available(
+      which = which,
+      system2 = system2
+    )
     flang <- flang_info$path
     if (!isTRUE(flang_info$available)) {
       if (isTRUE(explicit_request)) {

R/quick.R

@@ -213,7 +213,7 @@ compile <- function(fsub, build_dir = tempfile(paste0(fsub@name, "-build-"))) {
 
   # Link against the same BLAS/LAPACK/Fortran libs as the running R
   # to support generated calls to vendor BLAS (e.g., dgemm, dgesv).
-  cfg <- quickr_r_cmd_config_value
+  cfg <- quickr_cached_r_cmd_config_value
   BLAS_LIBS <- strsplit(cfg("BLAS_LIBS"), "[[:space:]]+")[[1]]
   LAPACK_LIBS <- strsplit(cfg("LAPACK_LIBS"), "[[:space:]]+")[[1]]
   FLIBS <- strsplit(cfg("FLIBS"), "[[:space:]]+")[[1]]
@@ -326,7 +326,7 @@ compile <- function(fsub, build_dir = tempfile(paste0(fsub@name, "-build-"))) {
 quickr_windows_add_dll_paths <- function(
   flags,
   os_type = .Platform$OS.type,
-  config_value = quickr_r_cmd_config_value,
+  config_value = quickr_cached_r_cmd_config_value,
   which = Sys.which
 ) {
   if (!identical(os_type, "windows")) {

tests/testthat/test-compiler.R

@@ -131,6 +131,11 @@ test_that("quickr_fortran_compiler_option validates values", {
 })
 
 test_that("quickr_fcompiler_env writes Makevars when flang is usable", {
+  rm(
+    list = ls(envir = quickr_compiler_probe_cache, all.names = TRUE),
+    envir = quickr_compiler_probe_cache
+  )
+
   temp <- withr::local_tempdir()
   prefix <- file.path(temp, "flang")
   dir.create(file.path(prefix, "bin"), recursive = TRUE)