initial work on cacheDir

Author: jjallaire

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.5
 Date: 2016-07-03
 Author: Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey,
  Qiang Kou, Douglas Bates and John Chambers

R/Attributes.R

@@ -23,6 +23,7 @@ sourceCpp <- function(file = "",
                       env = globalenv(),
                       embeddedR = TRUE,
                       rebuild = FALSE,
+                      cacheDir = tempdir(),
                       showOutput = verbose,
                       verbose = getOption("verbose"),
                       dryRun = FALSE) {
@@ -56,9 +57,16 @@ sourceCpp <- function(file = "",
         }
     }
 
+    # 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 <- normalizePath(cacheDir, winslash = "/", mustWork = FALSE)
+    cacheDir <- .sourceCppPlatformCacheDir(cacheDir)
+    
     # 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) {
@@ -202,6 +210,7 @@ cppFunction <- function(code,
                         includes = character(),
                         env = parent.frame(),
                         rebuild = FALSE,
+                        cacheDir = tempdir(),
                         showOutput = verbose,
                         verbose = getOption("verbose")) {
 
@@ -258,6 +267,7 @@ cppFunction <- function(code,
     exported <- sourceCpp(code = code,
                           env = env,
                           rebuild = rebuild,
+                          cacheDir = cacheDir,
                           showOutput = showOutput,
                           verbose = verbose)
 
@@ -304,6 +314,7 @@ evalCpp <- function(code,
                     plugins = character(), 
                     includes = character(),
                     rebuild = FALSE,
+                    cacheDir = tempdir(),
                     showOutput = verbose,
                     verbose = getOption( "verbose" ) ){
 
@@ -312,7 +323,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 +1000,93 @@ 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)
+}
+
+# read the cache from disk 
+.sourceCppDynlibReadCache <- function(cacheDir) {
+    index_file <- file.path(cacheDir, "cache.rds")
+    if (file.exists(index_file)) {
+        load(file = index_file)
+        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 ((!is.null(file) && identical(file, entry$file)) ||
+                (!is.null(code) && identical(code, entry$code))) {
+                return(i)
+            }
+        }
+    }
+    
+    # none found
+    NULL
+}
+
+# generate an R version / Rcpp version specific cache dir for dynlibs
+.sourceCppPlatformCacheDir <- function(cacheDir) {
+    
+    dir <- file.path(cacheDir,
+                     paste("sourceCpp",
+                           utils::packageVersion("Rcpp"),
+                           R.version$platform,
+                           R.version$`svn rev`,
+                           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

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

@@ -34,6 +34,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

@@ -28,6 +28,9 @@ 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{showOutput}{
     \code{TRUE} to print \code{R CMD SHLIB} output to the console.