boB Rudis
3 years ago
8 changed files with 154 additions and 14 deletions
@ -0,0 +1,2 @@ |
|||||
|
YEAR: 2021 |
||||
|
COPYRIGHT HOLDER: Bob Rudis |
@ -0,0 +1,21 @@ |
|||||
|
# MIT License |
||||
|
|
||||
|
Copyright (c) 2021 Bob Rudis |
||||
|
|
||||
|
Permission is hereby granted, free of charge, to any person obtaining a copy |
||||
|
of this software and associated documentation files (the "Software"), to deal |
||||
|
in the Software without restriction, including without limitation the rights |
||||
|
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell |
||||
|
copies of the Software, and to permit persons to whom the Software is |
||||
|
furnished to do so, subject to the following conditions: |
||||
|
|
||||
|
The above copyright notice and this permission notice shall be included in all |
||||
|
copies or substantial portions of the Software. |
||||
|
|
||||
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR |
||||
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, |
||||
|
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE |
||||
|
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER |
||||
|
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, |
||||
|
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE |
||||
|
SOFTWARE. |
@ -1,4 +1,4 @@ |
|||||
# Generated by roxygen2: do not edit by hand |
# Generated by roxygen2: do not edit by hand |
||||
|
|
||||
import(httr) |
export(add_registration_glue) |
||||
importFrom(jsonlite,fromJSON) |
import(rprojroot) |
||||
|
@ -0,0 +1,117 @@ |
|||||
|
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 |
||||
|
} |
||||
|
|
||||
|
} |
||||
|
|
||||
|
#' @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.") |
||||
|
} |
||||
|
|
||||
|
} |
@ -1,9 +1,8 @@ |
|||||
#' ... |
#' Seamless R and Swift Integration |
||||
#' |
#' |
||||
#' @md |
#' @md |
||||
#' @name swiftr |
#' @name swiftr |
||||
#' @keywords internal |
#' @keywords internal |
||||
#' @author Bob Rudis (bob@@rud.is) |
#' @author Bob Rudis (bob@@rud.is) |
||||
#' @import httr |
#' @import rprojroot stringi |
||||
#' @importFrom jsonlite fromJSON |
|
||||
"_PACKAGE" |
"_PACKAGE" |
||||
|
Loading…
Reference in new issue