R script for generating cbind macro header file

gen_cbind_macro_header.R

make_cbind_n <- function(n) {
  if (n == 2) {
    return("#define CBIND_IMPL_2(T1, T2) (cbind_impl(T1, T2))")
  }

  macro_args <- paste0("T", 1:n, collapse = ", ")
  call_args <- paste0("T", 1:(n-1), collapse = ", ")
  sprintf(
    "#define CBIND_IMPL_%i(%s) (CBIND_IMPL_2(CBIND_IMPL_%s(%s), T%i))",
    n, macro_args, n - 1, call_args, n
  )
}

make_nargs_seq <- function(n) {
  arg_seq <- paste0("_", 1:n, collapse = ",")
  sprintf(
    "#define NARGS_SEQ(%s,N,...) N",
    arg_seq
  )
}

make_nargs <- function(n) {
  sprintf(
    "#define NARGS(...) NARGS_SEQ(__VA_ARGS__, %s)",
    paste0(n:1, collapse = ", ")
  )
}

make_rest <- function() {
  sprintf(
    "%s\n%s\n\n%s\n%s\n",
    "#define PRIMITIVE_CAT(x, y) x ## y",
    "#define CAT(x, y) PRIMITIVE_CAT(x, y)",
    "#define DISPATCH_CBIND_IMPL(...) CAT(CBIND_IMPL_, NARGS(__VA_ARGS__))( __VA_ARGS__)",
    "#define cbind(...) (DISPATCH_CBIND_IMPL(__VA_ARGS__))"
  )
}

## Use:
## gen_cbind_macro_header("tmp/tmp_macro.h", n = 50)
gen_cbind_macro_header <- function(file, n = 50, include.guard = "CBIND__MACRO__DISPATCH__H") {
  if (n < 2) {
    stop("Require n >= 2")
  }

  cat(paste0(c("#ifndef ", "#define "), include.guard),
      "\n", file = file, sep = "\n")
  cat(sapply(2:n, make_cbind_n), "\n",
      file = file, sep = "\n", append = TRUE)
  cat(make_nargs_seq(n), make_nargs(n), "\n",
      file = file, sep = "\n", append = TRUE)
  cat(make_rest(), paste0("#endif // ", include.guard),
      "\n", file = file, sep = "\n", append = TRUE)
}