boB Rudis
3 years ago
7 changed files with 201 additions and 1 deletions
@ -1,5 +1,7 @@ |
|||||
# Generated by roxygen2: do not edit by hand |
# Generated by roxygen2: do not edit by hand |
||||
|
|
||||
export(add_registration_glue) |
export(add_registration_glue) |
||||
|
export(swift_function) |
||||
import(rprojroot) |
import(rprojroot) |
||||
import(stringi) |
import(stringi) |
||||
|
import(usethis) |
||||
|
@ -0,0 +1,167 @@ |
|||||
|
#' 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 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, 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("swift_%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.parent(parse(text = ƒ), 2) |
||||
|
|
||||
|
# list( |
||||
|
# fname = fname, |
||||
|
# params = params, |
||||
|
# pre = preflight, |
||||
|
# post = postflight |
||||
|
# ) |
||||
|
|
||||
|
} else { |
||||
|
|
||||
|
cat(readLines(stderr)) |
||||
|
|
||||
|
} |
||||
|
|
||||
|
} else { |
||||
|
|
||||
|
cat(readLines(stderr)) |
||||
|
|
||||
|
} |
||||
|
|
||||
|
} |
@ -0,0 +1,6 @@ |
|||||
|
#define USE_RINTERNALS |
||||
|
|
||||
|
#include <R.h> |
||||
|
#include <Rinternals.h> |
||||
|
|
||||
|
const char* R_CHAR(SEXP x); |
@ -0,0 +1,24 @@ |
|||||
|
% Generated by roxygen2: do not edit by hand |
||||
|
% Please edit documentation in R/swift-function.R |
||||
|
\name{swift_function} |
||||
|
\alias{swift_function} |
||||
|
\title{Define an R Function with a Swift Implementation} |
||||
|
\usage{ |
||||
|
swift_function(code, cache_dir = tempdir()) |
||||
|
} |
||||
|
\arguments{ |
||||
|
\item{code}{Source code for the Swift function definition.} |
||||
|
|
||||
|
\item{cache_dir}{Directory to use for caching shared libraries. The default |
||||
|
value of \code{\link[=tempdir]{tempdir()}} results in the cache being valid only for the current |
||||
|
R session. Pass an alternate directory to preserve the cache across R sessions.} |
||||
|
} |
||||
|
\description{ |
||||
|
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 \code{.Call} to invoke the library. |
||||
|
} |
||||
|
\note{ |
||||
|
Remember that the function need to be \code{public} and that you need to put |
||||
|
the required \verb{@_cdecl ("…")} decorator before the function definition. |
||||
|
} |
Loading…
Reference in new issue