PageRenderTime 38ms CodeModel.GetById 13ms RepoModel.GetById 0ms app.codeStats 0ms

/R/compile-dll.r

https://github.com/ryanmhood/devtools
R | 130 lines | 65 code | 24 blank | 41 comment | 9 complexity | 669f23363a5d1eefeccebe8c227c5fa4 MD5 | raw file
  1. #' Compile a .dll/.so from source.
  2. #'
  3. #' \code{compile_dll} performs a fake R CMD install so should code that
  4. #' works here should work with a regular install (and vice versa).
  5. #'
  6. #' During compilation, debug flags are set with
  7. #' \code{\link{compiler_flags}(TRUE)}.
  8. #'
  9. #' Invisibly returns the names of the DLL.
  10. #'
  11. #' @note If this is used to compile code that uses Rcpp, you will need to
  12. #' add the following line to your \code{Makevars} file so that it
  13. #' knows where to find the Rcpp headers:
  14. #' \code{PKG_CPPFLAGS=`$(R_HOME)/bin/Rscript -e 'Rcpp:::CxxFlags()'`}
  15. #'
  16. #' @param pkg package description, can be path or package name. See
  17. #' \code{\link{as.package}} for more information
  18. #' @param quiet if \code{TRUE} suppresses output from this function.
  19. #' @seealso \code{\link{clean_dll}} to delete the compiled files.
  20. #' @export
  21. compile_dll <- function(pkg = ".", quiet = FALSE) {
  22. pkg <- as.package(pkg)
  23. old <- set_envvar(compiler_flags(TRUE), "prefix")
  24. on.exit(set_envvar(old))
  25. if (!needs_compile(pkg)) return(invisible())
  26. compile_rcpp_attributes(pkg)
  27. # Mock install the package to generate the DLL
  28. if (!quiet) message("Re-compiling ", pkg$package)
  29. inst <- install_min(pkg, tempdir(), components = "libs",
  30. args = if (needs_clean(pkg)) "--preclean",
  31. quiet = quiet)
  32. dll_name <- paste(pkg$package, .Platform$dynlib.ext, sep = "")
  33. from <- file.path("inst", "libs", .Platform$r_arch, dll_name)
  34. to <- dll_path(pkg)
  35. file.copy(from, to)
  36. invisible(dll_path(pkg))
  37. }
  38. #' Remove compiled objects from /src/ directory
  39. #'
  40. #' Invisibly returns the names of the deleted files.
  41. #'
  42. #' @param pkg package description, can be path or package name. See
  43. #' \code{\link{as.package}} for more information
  44. #' @seealso \code{\link{compile_dll}}
  45. #' @export
  46. clean_dll <- function(pkg = ".") {
  47. pkg <- as.package(pkg)
  48. # Clean out the /src/ directory
  49. files <- dir(file.path(pkg$path, "src"),
  50. pattern = "\\.(o|sl|so|dylib|a|dll|def)$",
  51. full.names = TRUE)
  52. unlink(files)
  53. invisible(files)
  54. }
  55. # Returns the full path and name of the DLL file
  56. dll_path <- function(pkg = ".") {
  57. pkg <- as.package(pkg)
  58. name <- paste(pkg$package, .Platform$dynlib.ext, sep = "")
  59. file.path(pkg$path, "src", name)
  60. }
  61. mtime <- function(x) {
  62. x <- x[file.exists(x)]
  63. if (length(x) == 0) return(NULL)
  64. max(file.info(x)$mtime)
  65. }
  66. # List all source files in the package
  67. sources <- function(pkg = ".") {
  68. pkg <- as.package(pkg)
  69. srcdir <- file.path(pkg$path, "src")
  70. dir(srcdir, "\\.(c.*|f)$", recursive = TRUE, full.names = TRUE)
  71. }
  72. # List all header files in the package
  73. headers <- function(pkg = ".") {
  74. pkg <- as.package(pkg)
  75. incldir <- file.path(pkg$path, "inst", "include")
  76. srcdir <- file.path(pkg$path, "src")
  77. c(
  78. dir(srcdir, "^Makevars.*$", recursive = TRUE, full.names = TRUE),
  79. dir(srcdir, "\\.h.*$", recursive = TRUE, full.names = TRUE),
  80. dir(incldir, "\\.h.*$", recursive = TRUE, full.names = TRUE)
  81. )
  82. }
  83. # Does the package need recompiling?
  84. # (i.e. is there a source or header file newer than the dll)
  85. needs_compile <- function(pkg = ".") {
  86. pkg <- as.package(pkg)
  87. source <- mtime(c(sources(pkg), headers(pkg)))
  88. # no source files, so doesn't need compile
  89. if (is.null(source)) return(FALSE)
  90. dll <- mtime(dll_path(pkg))
  91. # no dll, so needs compile
  92. if (is.null(dll)) return(TRUE)
  93. source > dll
  94. }
  95. # Does the package need a clean compile?
  96. # (i.e. is there a header or Makevars newer than the dll)
  97. needs_clean <- function(pkg = ".") {
  98. pkg <- as.package(pkg)
  99. headers <- mtime(headers(pkg))
  100. # no headers, so never needs clean compile
  101. if (is.null(headers)) return(FALSE)
  102. dll <- mtime(dll_path(pkg))
  103. # no dll, so needs compile
  104. if (is.null(dll)) return(TRUE)
  105. headers > dll
  106. }