swift_function

DESCRIPTION

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

NAMESPACE

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

R/swift-function.R

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

R/swiftr-package.R

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

inst/include/swift-r-glue.h

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

man/swift_function.Rd

@@ -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.
+}