Merge pull request #187 from shikokuchuo/dev

Implements avoid loading `rlang` where not required
r-lib · Apr 29, 2024 · 968542a · 968542a
2 parents 771b884 + a74ec29
commit 968542a
Show file tree

Hide file tree

Showing 7 changed files with 75 additions and 41 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -20,7 +20,7 @@ Imports:
     rlang
 LinkingTo: Rcpp
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Suggests:
     knitr,
     rmarkdown,

diff --git a/NAMESPACE b/NAMESPACE
@@ -13,6 +13,5 @@ export(next_op_secs)
 export(run_now)
 export(with_loop)
 export(with_temp_loop)
-import(Rcpp)
 importFrom(Rcpp,evalCpp)
-useDynLib(later)
+useDynLib(later, .registration=TRUE)
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # later (development version)
 
+* Fixed #186: Improvements to package load time as `rlang` is now only loaded when used. This is a notable efficiency for packages with only a 'linking to' dependency on `later`. Also updates to native symbol registration from dynamic lookup. (@shikokuchuo and @wch, #187)
+
 # later 1.3.2
 
 * Fixed `unused variable` compiler warning. (@MichaelChirico, #176)

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -2,66 +2,66 @@
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
 testCallbackOrdering <- function() {
-    invisible(.Call('_later_testCallbackOrdering', PACKAGE = 'later'))
+    invisible(.Call(`_later_testCallbackOrdering`))
 }
 
 log_level <- function(level) {
-    .Call('_later_log_level', PACKAGE = 'later', level)
+    .Call(`_later_log_level`, level)
 }
 
 using_ubsan <- function() {
-    .Call('_later_using_ubsan', PACKAGE = 'later')
+    .Call(`_later_using_ubsan`)
 }
 
 setCurrentRegistryId <- function(id) {
-    invisible(.Call('_later_setCurrentRegistryId', PACKAGE = 'later', id))
+    invisible(.Call(`_later_setCurrentRegistryId`, id))
 }
 
 getCurrentRegistryId <- function() {
-    .Call('_later_getCurrentRegistryId', PACKAGE = 'later')
+    .Call(`_later_getCurrentRegistryId`)
 }
 
 deleteCallbackRegistry <- function(loop_id) {
-    .Call('_later_deleteCallbackRegistry', PACKAGE = 'later', loop_id)
+    .Call(`_later_deleteCallbackRegistry`, loop_id)
 }
 
 notifyRRefDeleted <- function(loop_id) {
-    .Call('_later_notifyRRefDeleted', PACKAGE = 'later', loop_id)
+    .Call(`_later_notifyRRefDeleted`, loop_id)
 }
 
 createCallbackRegistry <- function(id, parent_id) {
-    invisible(.Call('_later_createCallbackRegistry', PACKAGE = 'later', id, parent_id))
+    invisible(.Call(`_later_createCallbackRegistry`, id, parent_id))
 }
 
 existsCallbackRegistry <- function(id) {
-    .Call('_later_existsCallbackRegistry', PACKAGE = 'later', id)
+    .Call(`_later_existsCallbackRegistry`, id)
 }
 
 list_queue_ <- function(id) {
-    .Call('_later_list_queue_', PACKAGE = 'later', id)
+    .Call(`_later_list_queue_`, id)
 }
 
 execCallbacks <- function(timeoutSecs, runAll, loop_id) {
-    .Call('_later_execCallbacks', PACKAGE = 'later', timeoutSecs, runAll, loop_id)
+    .Call(`_later_execCallbacks`, timeoutSecs, runAll, loop_id)
 }
 
 idle <- function(loop_id) {
-    .Call('_later_idle', PACKAGE = 'later', loop_id)
+    .Call(`_later_idle`, loop_id)
 }
 
 ensureInitialized <- function() {
-    invisible(.Call('_later_ensureInitialized', PACKAGE = 'later'))
+    invisible(.Call(`_later_ensureInitialized`))
 }
 
 execLater <- function(callback, delaySecs, loop_id) {
-    .Call('_later_execLater', PACKAGE = 'later', callback, delaySecs, loop_id)
+    .Call(`_later_execLater`, callback, delaySecs, loop_id)
 }
 
 cancel <- function(callback_id_s, loop_id) {
-    .Call('_later_cancel', PACKAGE = 'later', callback_id_s, loop_id)
+    .Call(`_later_cancel`, callback_id_s, loop_id)
 }
 
 nextOpSecs <- function(loop_id) {
-    .Call('_later_nextOpSecs', PACKAGE = 'later', loop_id)
+    .Call(`_later_nextOpSecs`, loop_id)
 }
 
diff --git a/R/later.R b/R/later.R
@@ -1,5 +1,4 @@
-#' @useDynLib later
-#' @import Rcpp
+#' @useDynLib later, .registration=TRUE
 #' @importFrom Rcpp evalCpp
 
 .onLoad <- function(...) {
@@ -15,6 +14,17 @@
 # this registry to keep the loop objects alive.
 .loops <- new.env(parent = emptyenv())
 
+# Our own weakref functions are implemented (instead of using those from
+# `rlang`) to avoid loading `rlang` automatically upon package load, as this
+# causes additional overhead for packages which only link to `later`.
+new_weakref <- function(loop) {
+  .Call(`_later_new_weakref`, loop)
+}
+
+wref_key <- function(w) {
+  .Call(`_later_wref_key`, w)
+}
+
 #' Private event loops
 #'
 #' Normally, later uses a global event loop for scheduling and running
@@ -94,7 +104,7 @@ create_loop <- function(parent = current_loop(), autorun = NULL) {
   lockBinding("id", loop)
 
   # Add a weak reference to the loop object in our registry.
-  .loops[[sprintf("%d", id)]] <- rlang::new_weakref(loop)
+  .loops[[sprintf("%d", id)]] <- new_weakref(loop)
 
   if (id != 0L) {
     # Inform the C++ layer that there are no more R references when the handle
@@ -150,7 +160,7 @@ current_loop <- function() {
     stop("Current loop with id ", id, " not found.")
   }
 
-  loop <- rlang::wref_key(loop_weakref)
+  loop <- wref_key(loop_weakref)
   if (is.null(loop)) {
     stop("Current loop with id ", id, " not found.")
   }
@@ -249,8 +259,12 @@ print.event_loop <- function(x, ...) {
 #'
 #' @export
 later <- function(func, delay = 0, loop = current_loop()) {
-  f <- rlang::as_function(func)
-  id <- execLater(f, delay, loop$id)
+  # `rlang::as_function` is used conditionally so that `rlang` is not loaded
+  # until used, avoiding this overhead for packages only linking to `later`
+  if (!is.function(func)) {
+    func <- rlang::as_function(func)
+  }
+  id <- execLater(func, delay, loop$id)
 
   invisible(create_canceller(id, loop$id))
 }

diff --git a/src/init.c b/src/init.c
@@ -9,22 +9,24 @@ Check these declarations against the C/Fortran source code.
 */
 
 /* .Call calls */
-extern SEXP _later_ensureInitialized(void);
-extern SEXP _later_execCallbacks(SEXP, SEXP, SEXP);
-extern SEXP _later_idle(SEXP);
-extern SEXP _later_execLater(SEXP, SEXP, SEXP);
-extern SEXP _later_cancel(SEXP, SEXP);
-extern SEXP _later_nextOpSecs(SEXP);
-extern SEXP _later_testCallbackOrdering(void);
-extern SEXP _later_createCallbackRegistry(SEXP, SEXP);
-extern SEXP _later_deleteCallbackRegistry(SEXP);
-extern SEXP _later_existsCallbackRegistry(SEXP);
-extern SEXP _later_notifyRRefDeleted(SEXP);
-extern SEXP _later_setCurrentRegistryId(SEXP);
-extern SEXP _later_getCurrentRegistryId(void);
-extern SEXP _later_list_queue_(SEXP);
-extern SEXP _later_log_level(SEXP);
-extern SEXP _later_using_ubsan(void);
+SEXP _later_ensureInitialized(void);
+SEXP _later_execCallbacks(SEXP, SEXP, SEXP);
+SEXP _later_idle(SEXP);
+SEXP _later_execLater(SEXP, SEXP, SEXP);
+SEXP _later_cancel(SEXP, SEXP);
+SEXP _later_nextOpSecs(SEXP);
+SEXP _later_testCallbackOrdering(void);
+SEXP _later_createCallbackRegistry(SEXP, SEXP);
+SEXP _later_deleteCallbackRegistry(SEXP);
+SEXP _later_existsCallbackRegistry(SEXP);
+SEXP _later_notifyRRefDeleted(SEXP);
+SEXP _later_setCurrentRegistryId(SEXP);
+SEXP _later_getCurrentRegistryId(void);
+SEXP _later_list_queue_(SEXP);
+SEXP _later_log_level(SEXP);
+SEXP _later_using_ubsan(void);
+SEXP _later_new_weakref(SEXP);
+SEXP _later_wref_key(SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
   {"_later_ensureInitialized",      (DL_FUNC) &_later_ensureInitialized,      0},
@@ -43,6 +45,8 @@ static const R_CallMethodDef CallEntries[] = {
   {"_later_list_queue_",            (DL_FUNC) &_later_list_queue_,            1},
   {"_later_log_level",              (DL_FUNC) &_later_log_level,              1},
   {"_later_using_ubsan",            (DL_FUNC) &_later_using_ubsan,            0},
+  {"_later_new_weakref",            (DL_FUNC) &_later_new_weakref,            1},
+  {"_later_wref_key",               (DL_FUNC) &_later_wref_key,               1},
   {NULL, NULL, 0}
 };
 
@@ -54,6 +58,7 @@ void R_init_later(DllInfo *dll)
 {
   R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
   R_useDynamicSymbols(dll, FALSE);
+  R_forceSymbols(dll, TRUE);
   // 2019-08-06
   // execLaterNative is registered here ONLY for backward compatibility; If
   // someone installed a package which had `#include <later_api.h>` (like

diff --git a/src/wref.c b/src/wref.c
@@ -0,0 +1,14 @@
+#include <R.h>
+#include <Rinternals.h>
+
+SEXP _later_new_weakref(SEXP x){
+
+  return R_MakeWeakRef(x, R_NilValue, R_NilValue, FALSE);
+
+}
+
+SEXP _later_wref_key(SEXP x){
+
+  return R_WeakRefKey(x);
+
+}