auto_gen_note <- "// Generated by swiftr: do not edit by hand" preamble <- '#include #include #include #include ' 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.") } }