You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
121 lines
2.7 KiB
121 lines
2.7 KiB
auto_gen_note <- "// Generated by swiftr: do not edit by hand"
|
|
|
|
preamble <- '#include <R.h>
|
|
#include <Rinternals.h>
|
|
#include <stdlib.h>
|
|
#include <R_ext/Rdynload.h>
|
|
'
|
|
|
|
extern_template <- "extern SEXP %s(%s);"
|
|
|
|
method_template <- ' {"%s", (DL_FUNC) &%s, %s},'
|
|
|
|
postamble_template <- '
|
|
static const R_CallMethodDef CallEntries[] = {
|
|
%s
|
|
{NULL, NULL, 0}
|
|
};
|
|
|
|
void R_init_daybreak(DllInfo *dll) {
|
|
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
|
|
R_useDynamicSymbols(dll, FALSE);
|
|
}
|
|
'
|
|
|
|
populate_template <- function(src_dir, swift_src, glue_src) {
|
|
|
|
wd <- getwd()
|
|
on.exit(setwd(wd))
|
|
|
|
setwd(src_dir)
|
|
|
|
gsub(
|
|
"^import ", "",
|
|
grep("^import", readLines(file.path(src_dir, swift_src), warn=FALSE), value=TRUE)
|
|
) -> imports
|
|
|
|
if (length(imports) >= 1) {
|
|
imports <- sprintf("-framework %s", imports)
|
|
}
|
|
|
|
system2(
|
|
command = Sys.which("swiftc"),
|
|
args = c(
|
|
"-I /Library/Frameworks/R.framework/Headers",
|
|
"-F/Library/Frameworks",
|
|
"-framework R",
|
|
imports,
|
|
"-print-ast",
|
|
sprintf("-import-objc-header %s", glue_src),
|
|
swift_src
|
|
),
|
|
stdout = TRUE,
|
|
stderr = TRUE
|
|
) -> ast
|
|
|
|
func_lines <- which(grepl("@_cdec", ast))
|
|
|
|
funcs <- gsub('@_cdecl\\("|"\\)', "", ast[func_lines])
|
|
sexp_cts <- stringi::stri_count_fixed(ast[func_lines+1], "SEXP")-1
|
|
|
|
paste0(
|
|
mapply(function(func, sexp_ct) {
|
|
sprintf(extern_template, func, paste0(rep("SEXP", sexp_ct), collapse = ", "))
|
|
}, funcs, sexp_cts, SIMPLIFY = TRUE, USE.NAMES = FALSE),
|
|
collapse = "\n"
|
|
) -> externs
|
|
|
|
paste0(
|
|
mapply(function(func, sexp_ct) {
|
|
sprintf(method_template, func, func, sexp_ct)
|
|
}, funcs, sexp_cts, SIMPLIFY = TRUE, USE.NAMES = FALSE),
|
|
collapse = "\n"
|
|
) -> methods
|
|
|
|
paste(
|
|
auto_gen_note,
|
|
preamble,
|
|
externs,
|
|
sprintf(postamble_template, methods),
|
|
sep = "\n"
|
|
)
|
|
|
|
}
|
|
|
|
init_file_auto_generated <- function(src_dir) {
|
|
|
|
init_file <- file.path(src_dir, "init.c")
|
|
|
|
if (file.exists(init_file)) {
|
|
grepl(sprintf("^%s", auto_gen_note), readLines(init_file)[1])
|
|
} else {
|
|
TRUE
|
|
}
|
|
|
|
}
|
|
|
|
#' This examines a package swift file and builds the necessary registration glue code
|
|
#'
|
|
#' @param package where the package lives
|
|
#' @return nothing directly, but has a side effect of creating `init.c`
|
|
#' @export
|
|
add_registration_glue <- function(package = ".") {
|
|
|
|
makevars <- rprojroot::find_package_root_file("src/Makevars")
|
|
|
|
src_dir <- dirname(makevars)
|
|
|
|
if (init_file_auto_generated(src_dir)) {
|
|
|
|
swift_src <- list.files(src_dir, pattern = "swift$")
|
|
glue_src <- list.files(src_dir, pattern = "h$")
|
|
|
|
tmpl <- populate_template(src_dir, swift_src, glue_src)
|
|
|
|
writeLines(tmpl, file.path(src_dir, "init.c"))
|
|
|
|
} else {
|
|
stop("init.c was not auto-generated. Aborting.")
|
|
}
|
|
|
|
}
|
|
|