tools/gen_status_table.R

In Uno: R Interface to the 'Uno' Nonlinear Optimization Solver

#!/usr/bin/env Rscript
## tools/gen_status_table.R -- generate the status-label table of the R binding
## from Uno's C API header, so the labels uno_solve() returns follow Uno's enums
## and cannot drift when upstream adds or renames a status (Uno 2.9 added
## USER_INTERRUPTION and DIVERGING_ITERATE and renamed UNBOUNDED to
## UNBOUNDED_OBJECTIVE; a hand-written switch silently went stale).
##
## Run by ./configure and ./configure.win at install time:
##   Rscript tools/gen_status_table.R inst/uno/interfaces/C/Uno_C_API.h src/uno_status_names.h
##
## Input: the two constant blocks of Uno_C_API.h,
##   // Optimization status            // Iterate status
##   const uno_int UNO_SUCCESS = 0;    const uno_int UNO_NOT_OPTIMAL = 0;
##   ...                               ...
## each ended by a blank line. Output: an X-macro header,
##   #define UNO_R_OPTIMIZATION_STATUS_TABLE(X) X(UNO_SUCCESS, "SUCCESS", 0) ...
##   #define UNO_R_SOLUTION_STATUS_TABLE(X)     X(UNO_NOT_OPTIMAL, "NOT_OPTIMAL", 0) ...
## The label is the constant name without its UNO_ prefix (unopy's enum names).

args <- commandArgs(trailingOnly = TRUE)
if (length(args) != 2L) {
  stop("usage: Rscript tools/gen_status_table.R <Uno_C_API.h> <output.h>", call. = FALSE)
}
header <- args[[1L]]
output <- args[[2L]]
if (!file.exists(header)) stop("header not found: ", header, call. = FALSE)

sections <- c("// Optimization status" = "OPTIMIZATION", "// Iterate status" = "SOLUTION")
tables <- list(OPTIMIZATION = character(), SOLUTION = character())
constant_rx <- "^const\\s+uno_int\\s+(UNO_[A-Z0-9_]+)\\s*=\\s*(-?[0-9]+)\\s*;"

current <- NA_character_
for (line in readLines(header, warn = FALSE)) {
  text <- trimws(line)
  if (text %in% names(sections)) {
    current <- sections[[text]]
    next
  }
  if (is.na(current)) next
  if (!nzchar(text)) {            # a blank line ends the block
    current <- NA_character_
    next
  }
  m <- regmatches(text, regexec(constant_rx, text))[[1L]]
  if (length(m) == 3L) {
    tables[[current]][m[[2L]]] <- m[[3L]]
  }
}

## Uno 2.7.4 already had 6 optimization and 7 iterate statuses; fewer means the
## header layout changed and this parser must be revisited, not that Uno shrank.
if (length(tables$OPTIMIZATION) < 6L || length(tables$SOLUTION) < 7L) {
  stop(sprintf("parsed only %d optimization and %d solution statuses from %s",
               length(tables$OPTIMIZATION), length(tables$SOLUTION), header),
       call. = FALSE)
}

emit_table <- function(name, tab) {
  rows <- sprintf("  X(%s, \"%s\", %s)", names(tab), sub("^UNO_", "", names(tab)), unname(tab))
  c(sprintf("#define UNO_R_%s_STATUS_TABLE(X) \\", name),
    paste0(rows, c(rep(" \\", length(rows) - 1L), "")),
    "")
}

out <- c(
  sprintf("/* GENERATED by tools/gen_status_table.R from %s; do not edit.", basename(header)),
  sprintf(" * %d optimization statuses, %d solution statuses. X(constant, \"label\", value) */",
          length(tables$OPTIMIZATION), length(tables$SOLUTION)),
  "#ifndef UNO_R_STATUS_NAMES_H",
  "#define UNO_R_STATUS_NAMES_H",
  "",
  emit_table("OPTIMIZATION", tables$OPTIMIZATION),
  emit_table("SOLUTION", tables$SOLUTION),
  "#endif /* UNO_R_STATUS_NAMES_H */"
)
writeLines(out, output)
cat(sprintf("wrote %s: %d optimization, %d solution statuses\n", output,
            length(tables$OPTIMIZATION), length(tables$SOLUTION)))