R/eval.R

In rextendr: Call Rust Code from R using the 'extendr' Crate

#' Evaluate Rust code
#'
#' Compile and evaluate one or more Rust expressions. If the last
#' expression in the Rust code returns a value (i.e., does not end with
#' `;`), then this value is returned to R. The value returned does not need
#' to be of type `Robj`, as long as it can be cast into this type with
#' `.into()`. This conversion is done automatically, so you don't have to
#' worry about it in your code.
#' @param code Input rust code.
#' @param env The R environment in which the Rust code will be evaluated.
#' @param ... Other parameters handed off to [rust_function()].
#' @return The return value generated by the Rust code.
#' @examples
#' \dontrun{
#' # Rust code without return value, called only for its side effects
#' rust_eval(
#'   code = 'rprintln!("hello from Rust!");'
#' )
#'
#' # Rust code with return value
#' rust_eval(
#'   code = "
#'     let x = 5;
#'     let y = 7;
#'     let z = x * y;
#'     z // return to R; rust_eval() takes care of type conversion code
#'  "
#' )
#' }
#' @export
rust_eval <- function(code, env = parent.frame(), ...) {
  rust_eval_deferred(code = code, env = env, ...)()
}

#' Evaluate Rust code (deferred)
#'
#' Compiles a chunk of Rust code and returns an R function,
#' which, when called, executes Rust code.
#' This allows to separate Rust code compilation and execution.
#' The function can be called only once, it cleans up resources on exit,
#' including loaded dll and sourced R wrapper.
#'
#' @inheritParams rust_eval
#' @return \[`function()`\] An R function with no argumetns.
#' @noRd
rust_eval_deferred <- function(code, env = parent.frame(), ...) {
  # make sure code is given as a single character string
  code <- glue_collapse(code, sep = "\n")

  # Snippet hash is constructed from the Rust source code and
  # a unique identifier of the compiled dll.
  # Every time any rust code is dynamically compiled,
  # `the$count` is incremented.
  # This ensures that any two (even bytewise-identical)
  # Rust source code strings will have different
  # hashes.
  snippet_hash <- rlang::hash(list(the$count, code)) # nolint: object_usage_linter

  # The unique hash is then used to generate unique function names
  fn_name <- glue("rextendr_rust_eval_fun_{snippet_hash}")

  # wrap code into Rust function
  code_wrapped <- glue(r"(
fn {fn_name}() -> Result<Robj> {{
  let x = {{
    {code}
  }};
  Ok(x.into())
}}
)")

  # Attempt to figure out whether the Rust code returns a result or not,
  # and make the result invisible or not accordingly. This regex approach
  # is not perfect, but since it only affects the visibility of the result
  # that's Ok. Worst case scenario a result that should be invisible is
  # shown as visible.
  has_no_return <- grepl(".*;\\s*$", code, perl = TRUE)

  out <- rust_function(code = code_wrapped, env = env, ...)

  generated_fn <- function() {
    fn_handle <- get0(fn_name, envir = env, ifnotfound = NULL)
    dll_handle <- find_loaded_dll(out[["name"]])
    if (
      rlang::is_null(fn_handle) ||
        rlang::is_null(dll_handle)
    ) {
      cli::cli_abort(
        c(
          "The Rust code fragment is no longer available for execution.",
          "i" = "Code fragment can only be executed once.",
          "!" = "Make sure you are not re-using an outdated fragment."
        ),
        class = "rextendr_error"
      )
    }

    withr::defer(dyn.unload(out[["path"]]))
    withr::defer(rm(list = fn_name, envir = env))

    result <- rlang::exec(fn_name, .env = env)
    if (has_no_return) {
      invisible(result)
    } else {
      result
    }
  }

  attr(generated_fn, "function_name") <- fn_name
  attr(generated_fn, "dll_path") <- out[["path"]]

  generated_fn
}


#' Find loaded dll by name
#' @param name \[`string`\] Name of the dll (as returned by `dyn.load(...)[["name"]]`).
#' @return \[`DllInfo`|`NULL`\] An object representing a loaded dll or
#'   `NULL` if no such dll is loaded.
#' @noRd
find_loaded_dll <- function(name) {
  dlls <- purrr::keep(getLoadedDLLs(), ~ .x[["name"]] == name)
  if (rlang::is_empty(dlls)) {
    NULL
  } else {
    dlls[[1]]
  }
}