Merge pull request #504 from RcppCore/feature/source-cpp-cache-dir

Enable caching of sourceCpp compilations across R sessions

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,10 @@
+2016-07-11  J.J. Allaire <[email protected]>
+
+        * R/Attributes.R Add cacheDir argument to sourceCpp to enable caching of 
+        shared libraries across R sessions
+        * src/attributes.cpp Add cacheDir argument to sourceCpp to enable caching of 
+        shared libraries across R sessions
+
 2016-07-03  Dirk Eddelbuettel  <[email protected]>
 
         * DESCRIPTION (Version): Rolling minor version

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.12.5.4
+Version: 0.12.5.7
 Date: 2016-07-03
 Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey,
  Qiang Kou, Douglas Bates and John Chambers

R/Attributes.R

@@ -23,15 +23,24 @@ sourceCpp <- function(file = "",
                       env = globalenv(),
                       embeddedR = TRUE,
                       rebuild = FALSE,
+                      cacheDir = getOption("rcpp.cache.dir", tempdir()),
+                      cleanupCacheDir = FALSE,
                       showOutput = verbose,
                       verbose = getOption("verbose"),
                       dryRun = FALSE) {
 
+    # use an architecture/version specific subdirectory of the cacheDir
+    # (since cached dynlibs can now perist across sessions we need to be
+    # sure to invalidate them when R or Rcpp versions change)
+    cacheDir <- path.expand(cacheDir)
+    cacheDir <- .sourceCppPlatformCacheDir(cacheDir)
+    cacheDir <- normalizePath(cacheDir)
+    
     # resolve code into a file if necessary. also track the working
     # directory to source the R embedded code chunk within
     if (!missing(code)) {
         rWorkingDir <- getwd()
-        file <- tempfile(fileext = ".cpp")
+        file <- tempfile(fileext = ".cpp", tmpdir = cacheDir)
         con <- file(file, open = "w")
         writeLines(code, con)
         close(con)
@@ -55,10 +64,10 @@ sourceCpp <- function(file = "",
                  "is not permitted.")
         }
     }
-
+    
     # get the context (does code generation as necessary)
     context <- .Call("sourceCppContext", PACKAGE="Rcpp",
-                     file, code, rebuild, .Platform)
+                     file, code, rebuild, cacheDir, .Platform)
 
     # perform a build if necessary
     if (context$buildRequired || rebuild) {
@@ -105,7 +114,7 @@ sourceCpp <- function(file = "",
 
         # unload and delete existing dylib if necessary
         if (file.exists(context$previousDynlibPath)) {
-            try(silent=T, dyn.unload(context$previousDynlibPath))
+            try(silent=TRUE, dyn.unload(context$previousDynlibPath))
             file.remove(context$previousDynlibPath)
         }
 
@@ -189,10 +198,37 @@ sourceCpp <- function(file = "",
         setwd(rWorkingDir) # will be reset by previous on.exit handler
         source(file=srcConn, echo=TRUE)
     }
+    
+    # cleanup the cache dir if requested
+    if (cleanupCacheDir)
+        cleanupSourceCppCache(cacheDir, context$cppSourcePath, context$buildDirectory)
 
     # return (invisibly) a list containing exported functions and modules
     invisible(list(functions = context$exportedFunctions,
-                   modules = context$modules))
+                   modules = context$modules,
+                   cppSourcePath = context$cppSourcePath,
+                   buildDirectory = context$buildDirectory))
+}
+
+
+# Cleanup a directory used as the cache for a sourceCpp compilation. This will
+# remove all files from the cache directory that aren't a result of the 
+# compilation that yielded the passed buildDirectory. 
+cleanupSourceCppCache <- function(cacheDir, cppSourcePath, buildDirectory) {
+    # normalize cpp source path and build directory 
+    cppSourcePath <- normalizePath(cppSourcePath)
+    buildDirectory <- normalizePath(buildDirectory)
+    
+    # determine the parent dir that was used for the compilation then collect all the
+    # *.cpp files and subdirectories therein
+    cacheFiles <- list.files(cacheDir, pattern = glob2rx("*.cpp"), recursive = FALSE, full.names = TRUE)
+    cacheFiles <- c(cacheFiles, list.dirs(cacheDir, recursive = FALSE, full.names = TRUE))
+    cacheFiles <- normalizePath(cacheFiles)
+    
+    # determine the list of tiles that were not yielded by the passed sourceCpp
+    # result and remove them
+    oldCacheFiles <- cacheFiles[!cacheFiles %in% c(cppSourcePath, buildDirectory)]
+    unlink(oldCacheFiles, recursive = TRUE)
 }
 
 # Define a single C++ function
@@ -202,6 +238,7 @@ cppFunction <- function(code,
                         includes = character(),
                         env = parent.frame(),
                         rebuild = FALSE,
+                        cacheDir = getOption("rcpp.cache.dir", tempdir()),
                         showOutput = verbose,
                         verbose = getOption("verbose")) {
 
@@ -258,6 +295,7 @@ cppFunction <- function(code,
     exported <- sourceCpp(code = code,
                           env = env,
                           rebuild = rebuild,
+                          cacheDir = cacheDir,
                           showOutput = showOutput,
                           verbose = verbose)
 
@@ -304,6 +342,7 @@ evalCpp <- function(code,
                     plugins = character(), 
                     includes = character(),
                     rebuild = FALSE,
+                    cacheDir = getOption("rcpp.cache.dir", tempdir()),
                     showOutput = verbose,
                     verbose = getOption( "verbose" ) ){
 
@@ -312,7 +351,7 @@ evalCpp <- function(code,
     env <- new.env()
     cppFunction(code, depends = depends, plugins = plugins,
                 includes = includes, env = env,
-                rebuild = rebuild, showOutput = showOutput, verbose = verbose )
+                rebuild = rebuild, cacheDir = cacheDir, showOutput = showOutput, verbose = verbose )
     fun <- env[["get_value"]]
     fun()
 }
@@ -989,3 +1028,92 @@ sourceCppFunction <- function(func, isVoid, dll, symbol) {
     }
     .hasDevelTools
 }
+
+
+# insert a dynlib entry into the cache
+.sourceCppDynlibInsert <- function(cacheDir, file, code, dynlib) {
+    cache <- .sourceCppDynlibReadCache(cacheDir)
+    index <- .sourceCppFindCacheEntryIndex(cache, file, code)
+    if (is.null(index))
+        index <- length(cache) + 1
+    cache[[index]] <- list(file = file, code = code, dynlib = dynlib)
+    .sourceCppDynlibWriteCache(cacheDir, cache)
+}
+
+# attempt to lookup a dynlib entry from the cache
+.sourceCppDynlibLookup <- function(cacheDir, file, code) {
+    cache <- .sourceCppDynlibReadCache(cacheDir)
+    index <- .sourceCppFindCacheEntryIndex(cache, file, code)
+    if (!is.null(index))
+        cache[[index]]$dynlib
+    else
+        list()
+}
+
+# write the cache to disk
+.sourceCppDynlibWriteCache <- function(cacheDir, cache) {
+    index_file <- file.path(cacheDir, "cache.rds")
+    save(cache, file = index_file, compress = FALSE)
+}
+
+# read the cache from disk 
+.sourceCppDynlibReadCache <- function(cacheDir) {
+    index_file <- file.path(cacheDir, "cache.rds")
+    if (file.exists(index_file)) {
+        load(file = index_file)
+        get("cache")
+    } else {
+        list()
+    }
+}
+
+# search the cache for an entry that matches the file or code argument
+.sourceCppFindCacheEntryIndex <- function(cache, file, code) {
+    
+    if (length(cache) > 0) {
+        for (i in 1:length(cache)) {
+            entry <- cache[[i]]
+            if ((nzchar(file) && identical(file, entry$file)) ||
+                (nzchar(code) && identical(code, entry$code))) {
+                if (file.exists(entry$dynlib$cppSourcePath))
+                    return(i)
+            }
+        }
+    }
+    
+    # none found
+    NULL
+}
+
+# generate an R version / Rcpp version specific cache dir for dynlibs
+.sourceCppPlatformCacheDir <- function(cacheDir) {
+    
+    dir <- file.path(cacheDir,
+                     paste(R.version$platform,
+                           utils::packageVersion("Rcpp"),
+                           sep = "-"))
+    if (!dir.exists(dir))
+        dir.create(dir, recursive = TRUE)
+    
+    dir
+}
+
+# generate a unique token for a cacheDir
+.sourceCppDynlibUniqueToken <- function(cacheDir) {
+    # read existing token (or create a new one)
+    token_file <- file.path(cacheDir, "token.rds")
+    if (file.exists(token_file))
+        load(file = token_file)
+    else
+        token <- 0
+    
+    # increment
+    token <- token + 1
+    
+    # write it
+    save(token, file = token_file)
+    
+    # return it as a string
+    as.character(token)
+}
+

inst/NEWS.Rd

@@ -33,6 +33,8 @@
     }
     \item Changes in Rcpp Attributes:
     \itemize{
+      \item Add \code{cacheDir} argument to \code{sourceCpp()} to enable caching of 
+        shared libraries across R sessions.
       \item Code generation now deals correctly which packages containing a dot
       in their name (Qiang in \ghpr{501} fixing \ghit{500})
     }

man/cppFunction.Rd

@@ -7,8 +7,8 @@ Define an R Function with a C++ Implementation
 Dynamically define an R function with C++ source code. Compiles and links a shared library with bindings to the C++ function then defines an R function that uses \code{.Call} to invoke the library.
 }
 \usage{
-cppFunction(code, depends = character(), plugins = character(),
-            includes = character(), env = parent.frame(), rebuild = FALSE, 
+cppFunction(code, depends = character(), plugins = character(), includes = character(),
+            env = parent.frame(), rebuild = FALSE, cacheDir = getOption("rcpp.cache.dir", tempdir()), 
             showOutput = verbose, verbose = getOption("verbose"))
 }
 
@@ -30,6 +30,9 @@ cppFunction(code, depends = character(), plugins = character(),
 }
   \item{rebuild}{
     Force a rebuild of the shared library.
+}
+  \item{cacheDir}{
+    Directory to use for caching shared libraries. If the underlying code passed to \code{sourceCpp} has not changed since the last invocation then a cached version of the shared library is used. The default value of \code{tempdir()} results in the cache being valid only for the current R session. Pass an alternate directory to preserve the cache across R sessions.
 }
   \item{showOutput}{
     \code{TRUE} to print \code{R CMD SHLIB} output to the console.

man/evalCpp.Rd

@@ -9,9 +9,10 @@ Evaluates a C++ expression. This creates a C++ function using
 \code{\link{cppFunction}} and calls it to get the result. 
 }
 \usage{
-evalCpp(code, depends = character(), plugins = character(),
-        includes = character(), rebuild = FALSE, showOutput = verbose, 
-        verbose = getOption("verbose"))
+evalCpp(code, depends = character(), plugins = character(), includes = character(), 
+        rebuild = FALSE, cacheDir = getOption("rcpp.cache.dir", tempdir()),
+        showOutput = verbose, verbose = getOption("verbose"))
+
 areMacrosDefined(names, depends = character(), includes = character(), 
         rebuild = FALSE, showOutput = verbose, 
         verbose = getOption("verbose"))
@@ -34,6 +35,9 @@ see \code{\link{cppFunction}}
 }
   \item{rebuild}{
 see \code{\link{cppFunction}}
+}
+  \item{cacheDir}{
+    Directory to use for caching shared libraries. If the underlying code passed to \code{sourceCpp} has not changed since the last invocation then a cached version of the shared library is used. The default value of \code{tempdir()} results in the cache being valid only for the current R session. Pass an alternate directory to preserve the cache across R sessions.
 }
   \item{showOutput}{
 see \code{\link{cppFunction}}

man/sourceCpp.Rd

@@ -8,10 +8,9 @@ Source C++ Code from a File or String
 and RCPP_MODULE declarations. A shared library is then built and its exported functions and Rcpp modules are made available in the specified environment.
 }
 \usage{
-sourceCpp(file = "", code = NULL, env = globalenv(),
-          embeddedR = TRUE, rebuild = FALSE,
-          showOutput = verbose, verbose = getOption("verbose"),
-          dryRun = FALSE)
+sourceCpp(file = "", code = NULL, env = globalenv(), embeddedR = TRUE, rebuild = FALSE, 
+          cacheDir = getOption("rcpp.cache.dir", tempdir()), cleanupCacheDir = FALSE,
+          showOutput = verbose, verbose = getOption("verbose"), dryRun = FALSE)
 }
 \arguments{
   \item{file}{
@@ -28,6 +27,12 @@ sourceCpp(file = "", code = NULL, env = globalenv(),
 }
   \item{rebuild}{
     Force a rebuild of the shared library.
+}
+  \item{cacheDir}{
+    Directory to use for caching shared libraries. If the underlying file or code passed to \code{sourceCpp} has not changed since the last invocation then a cached version of the shared library is used. The default value of \code{tempdir()} results in the cache being valid only for the current R session. Pass an alternate directory to preserve the cache across R sessions.
+}
+\item{cleanupCacheDir}{
+    Cleanup all files in the cacheDir that were not a result of this compilation. Note that this will cleanup the cache from all other calls to sourceCpp with the same cacheDir. This option should therefore only be specified by callers that provide a unique cacheDir per scope (e.g. chunk labels in a weaved document).
 }
   \item{showOutput}{
     \code{TRUE} to print \code{R CMD SHLIB} output to the console.
@@ -71,7 +76,7 @@ fibonacci(10)
 */
 }
 
-	Multiple R code chunks can be included in a C++ file. R code is sourced after the C++ compliation is completed so all functions and modules will be available to the R code.   
+	Multiple R code chunks can be included in a C++ file. R code is sourced after the C++ compilation is completed so all functions and modules will be available to the R code.   
 }
 
 \value{