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.
172 lines
4.7 KiB
172 lines
4.7 KiB
#' Define an R Function with a Swift Implementation
|
|
#'
|
|
#' Dynamically define an R function with Swift source code. Compiles and links
|
|
#' a shard library with bindings to the Swift function then defines an R function
|
|
#' that uses `.Call` to invoke the library.
|
|
#'
|
|
#' @param code Source code for the Swift function definition.
|
|
#' @param env Environment where the R functions and modules should be made available.
|
|
#' @param imports Character vector of Swift frameworks to import.
|
|
#' @param cache_dir Directory to use for caching shared libraries. The default
|
|
#' value of [tempdir()] results in the cache being valid only for the current
|
|
#' R session. Pass an alternate directory to preserve the cache across R sessions.
|
|
#' @note Remember that the function need to be `public` and that you need to put
|
|
#' the required `@@_cdecl ("…")` decorator before the function definition.
|
|
#' @export
|
|
swift_function <- function(code, env = globalenv(), imports = c("Foundation"), cache_dir = tempdir()) {
|
|
|
|
arch <- sprintf("--%s", Sys.info()["machine"])
|
|
|
|
swiftc <- Sys.which("swiftc")
|
|
|
|
bridging_header <- system.file("include", "swift-r-glue.h", package = "swiftr")
|
|
|
|
source_file <- basename(tempfile(fileext = ".swift"))
|
|
|
|
module_name <- sprintf("swiftr_%s", digest::digest(code))
|
|
|
|
writeLines(
|
|
text = c(
|
|
sprintf("import %s", imports),
|
|
code
|
|
),
|
|
con = file.path(cache_dir, source_file)
|
|
)
|
|
|
|
wd <- getwd()
|
|
on.exit(setwd(wd))
|
|
|
|
setwd(cache_dir)
|
|
|
|
stdout <- tempfile(fileext = ".out")
|
|
stderr <- tempfile(fileext = ".err")
|
|
|
|
# preflight to get info
|
|
|
|
system2(
|
|
command = swiftc,
|
|
args = c(
|
|
"-I/Library/Frameworks/R.framework/Headers",
|
|
"-F/Library/Frameworks",
|
|
"-framework", "R",
|
|
"-import-objc-header", bridging_header,
|
|
"-parseable-output",
|
|
"-print-ast",
|
|
file.path(cache_dir, source_file)
|
|
),
|
|
stdout = stdout,
|
|
stderr = stderr
|
|
) -> res
|
|
|
|
if (res == 0) {
|
|
|
|
stri_replace_all_regex(
|
|
readLines(stderr, warn=FALSE),
|
|
pattern = "^([[:digit:]]+)$",
|
|
replacement = ',"$1":'
|
|
) -> l
|
|
l[1] <- stri_replace_first_regex(l[1], "^,", "{")
|
|
writeLines(c(l, "}"), stderr)
|
|
|
|
preflight <- jsonlite::fromJSON(stderr, simplifyDataFrame = FALSE)
|
|
|
|
system2(
|
|
command = swiftc,
|
|
args = c(
|
|
"-I/Library/Frameworks/R.framework/Headers",
|
|
"-F/Library/Frameworks",
|
|
"-framework", "R",
|
|
"-emit-library",
|
|
"-module-name", module_name,
|
|
"-import-objc-header", bridging_header,
|
|
"-parseable-output",
|
|
file.path(cache_dir, source_file)
|
|
),
|
|
stdout = stdout,
|
|
stderr = stderr
|
|
) -> res
|
|
|
|
if (res == 0) {
|
|
|
|
stri_replace_all_regex(
|
|
readLines(stderr, warn=FALSE),
|
|
pattern = "^([[:digit:]]+)$",
|
|
replacement = ',"$1":'
|
|
) -> l
|
|
l[1] <- stri_replace_first_regex(l[1], "^,", "{")
|
|
writeLines(c(l, "}"), stderr)
|
|
|
|
postflight <- jsonlite::fromJSON(stderr, simplifyDataFrame = FALSE)
|
|
|
|
code <- unlist(stri_split_lines(preflight[[4]]$output, omit_empty = TRUE))
|
|
|
|
func <- grep("^[[:space:]]*public[[:space:]]+func[[:space:]]+", code, value = TRUE)
|
|
|
|
stri_match_first_regex(
|
|
str = func,
|
|
pattern = "
|
|
^[[:space:]]*
|
|
public
|
|
[[:space:]]+
|
|
func
|
|
[[:space:]]+
|
|
([^\\(]+)
|
|
",
|
|
opts_regex = stri_opts_regex(comments = TRUE)
|
|
) -> fname
|
|
|
|
fname <- fname[,2]
|
|
|
|
params <- stri_replace_first_regex(func, "^[^\\(]+\\(", "")
|
|
params <- stri_replace_last_regex(params, "\\).*$", "")
|
|
params <- stri_replace_all_regex(params, "_[[:space:]]+", "")
|
|
params <- unlist(stri_split_regex(params, ",[[:space:]]*"))
|
|
params <- stri_match_first_regex(params, "([^:]+):")[,2]
|
|
|
|
try(dyn.unload(file.path(cache_dir, sprintf("lib%s.dylib", module_name))), silent=TRUE)
|
|
dyn.load(file.path(cache_dir, sprintf("lib%s.dylib", module_name)))
|
|
|
|
rsrc_fil <- tempfile(fileext = ".R")
|
|
|
|
paste0(c(
|
|
sprintf(
|
|
"%s <- function(%s) {",
|
|
fname,
|
|
ifelse(is.na(params[1]), "", paste0(params, collapse = ", "))
|
|
),
|
|
sprintf(
|
|
' .Call("%s"%s%s)',
|
|
fname,
|
|
ifelse(is.na(params[1]), "", ", "),
|
|
ifelse(is.na(params[1]), "", paste0(params, collapse = ", "))
|
|
),
|
|
"}"),
|
|
collapse = "\n"
|
|
) -> ƒ
|
|
|
|
eval(parse(text = ƒ), envir = env)
|
|
|
|
# list(
|
|
# fname = fname,
|
|
# params = params,
|
|
# pre = preflight,
|
|
# post = postflight
|
|
# )
|
|
|
|
} else {
|
|
|
|
message("COMPILATION ERROR")
|
|
|
|
# cat(readLines(stderr))
|
|
|
|
}
|
|
|
|
} else {
|
|
|
|
message("SYNTAX ERROR")
|
|
|
|
# cat(readLines(stderr))
|
|
|
|
}
|
|
|
|
}
|