Browse Source

swift_function

master
boB Rudis 2 months ago
parent
commit
9ad02509a2
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
7 changed files with 201 additions and 1 deletions
  1. +1
    -0
      DESCRIPTION
  2. +2
    -0
      NAMESPACE
  3. +167
    -0
      R/swift-function.R
  4. +1
    -1
      R/swiftr-package.R
  5. +0
    -0
      R/utils.R
  6. +6
    -0
      inst/include/swift-r-glue.h
  7. +24
    -0
      man/swift_function.Rd

+ 1
- 0
DESCRIPTION View File

@ -19,6 +19,7 @@ Depends:
R (>= 3.6.0)
Imports:
rprojroot,
usethis,
stringi
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1

+ 2
- 0
NAMESPACE View File

@ -1,5 +1,7 @@
# Generated by roxygen2: do not edit by hand
export(add_registration_glue)
export(swift_function)
import(rprojroot)
import(stringi)
import(usethis)

+ 167
- 0
R/swift-function.R View File

@ -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))
}
}

+ 1
- 1
R/swiftr-package.R View File

@ -4,5 +4,5 @@
#' @name swiftr
#' @keywords internal
#' @author Bob Rudis (bob@@rud.is)
#' @import rprojroot stringi
#' @import rprojroot stringi usethis
"_PACKAGE"

+ 0
- 0
R/utils.R View File


+ 6
- 0
inst/include/swift-r-glue.h View File

@ -0,0 +1,6 @@
#define USE_RINTERNALS
#include <R.h>
#include <Rinternals.h>
const char* R_CHAR(SEXP x);

+ 24
- 0
man/swift_function.Rd View File

@ -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…
Cancel
Save