[rkward/work/faster_watch] /: Further optimizations, cleanups and comments to symbol watching.
Thomas Friedrichsmeier
null at kde.org
Mon Apr 9 09:25:54 UTC 2018
Git commit e8a1f8cfba6d27774d923aab58848b9494e936a6 by Thomas Friedrichsmeier.
Committed on 09/04/2018 at 09:21.
Pushed by tfry into branch 'work/faster_watch'.
Further optimizations, cleanups and comments to symbol watching.
Importantly, there is a dedicate .Call() entry point for symbol watching, now,
which yielded the biggest contribution to the total ~25% speed increase in this patch.
(testcase as before).
M +10 -10 rkward/rbackend/rkrbackend.cpp
M +0 -1 rkward/rbackend/rpackages/rkward/NAMESPACE
M +5 -3 rkward/rbackend/rpackages/rkward/R/base_overrides.R
M +6 -10 rkward/rbackend/rpackages/rkward/R/internal.R
M +1 -1 tests/rkward_application_tests.R
https://commits.kde.org/rkward/e8a1f8cfba6d27774d923aab58848b9494e936a6
diff --git a/rkward/rbackend/rkrbackend.cpp b/rkward/rbackend/rkrbackend.cpp
index d09ba41a..541d9daa 100644
--- a/rkward/rbackend/rkrbackend.cpp
+++ b/rkward/rbackend/rkrbackend.cpp
@@ -869,6 +869,14 @@ SEXP doError (SEXP call) {
return R_NilValue;
}
+SEXP doWs (SEXP name) {
+ if ((!RKRBackend::this_pointer->current_command) || (RKRBackend::this_pointer->current_command->type & RCommand::ObjectListUpdate) || (!(RKRBackend::this_pointer->current_command->type & RCommand::Sync))) { // ignore Sync commands that are not flagged as ObjectListUpdate
+ QString sym = RKRSupport::SEXPToString(name);
+ if (!RKRBackend::this_pointer->changed_symbol_names.contains (sym)) RKRBackend::this_pointer->changed_symbol_names.append (sym); // schedule symbol update for later
+ }
+ return R_NilValue;
+}
+
SEXP doSubstackCall (SEXP call) {
RK_TRACE (RBACKEND);
@@ -876,16 +884,6 @@ SEXP doSubstackCall (SEXP call) {
QStringList list = RKRSupport::SEXPToStringList (call);
- // handle symbol updates inline
- if (list.count () == 2) { // schedule symbol update for later
- if (list[0] == "ws") {
- // always keep in mind: No current command can happen for tcl/tk events.
- if ((!RKRBackend::this_pointer->current_command) || (RKRBackend::this_pointer->current_command->type & RCommand::ObjectListUpdate) || (!(RKRBackend::this_pointer->current_command->type & RCommand::Sync))) { // ignore Sync commands that are not flagged as ObjectListUpdate
- if (!RKRBackend::this_pointer->changed_symbol_names.contains (list[1])) RKRBackend::this_pointer->changed_symbol_names.append (list[1]);
- }
- return R_NilValue;
- }
- }
/* // this is a useful place to sneak in test code for profiling
if (list.value (0) == "testit") {
for (int i = 10000; i >= 1; --i) {
@@ -970,6 +968,7 @@ SEXP doCopyNoEval (SEXP fromname, SEXP fromenv, SEXP toname, SEXP toenv) {
SEXP RKStartGraphicsDevice (SEXP width, SEXP height, SEXP pointsize, SEXP family, SEXP bg, SEXP title, SEXP antialias);
SEXP RKD_AdjustSize (SEXP devnum);
+SEXP doWs (SEXP name);
void doPendingPriorityCommands ();
bool RKRBackend::startR () {
@@ -1044,6 +1043,7 @@ bool RKRBackend::startR () {
// register our functions
R_CallMethodDef callMethods [] = {
+ { "ws", (DL_FUNC) &doWs, 1 },
{ "rk.do.error", (DL_FUNC) &doError, 1 },
{ "rk.do.command", (DL_FUNC) &doSubstackCall, 1 },
{ "rk.do.generic.request", (DL_FUNC) &doPlainGenericRequest, 2 },
diff --git a/rkward/rbackend/rpackages/rkward/NAMESPACE b/rkward/rbackend/rpackages/rkward/NAMESPACE
index 811ab90a..5d7c6cd3 100644
--- a/rkward/rbackend/rpackages/rkward/NAMESPACE
+++ b/rkward/rbackend/rpackages/rkward/NAMESPACE
@@ -43,7 +43,6 @@ export(.rk.unwatch.symbol)
export(.rk.variables)
export(.rk.watch.globalenv)
export(.rk.watch.symbol)
-export(.rk.watched.symbols)
export(.rk.with.window.hints)
export(RK)
export(Sys.setlocale)
diff --git a/rkward/rbackend/rpackages/rkward/R/base_overrides.R b/rkward/rbackend/rpackages/rkward/R/base_overrides.R
index 8f10b56c..9d2e2a6c 100644
--- a/rkward/rbackend/rpackages/rkward/R/base_overrides.R
+++ b/rkward/rbackend/rpackages/rkward/R/base_overrides.R
@@ -1,12 +1,14 @@
-
# override makeActiveBinding: If active bindings are created in globalenv (), watch them properly
+# Ideally this would not be needed, but there seems to be no user-accessible way to copy unevaluated active bindings.
.rk.makeActiveBinding.default <- base::makeActiveBinding
#' @export
"makeActiveBinding" <- function (sym, fun, env, ...) {
if (identical (env, globalenv ())) {
- .rk.makeActiveBinding.default (sym, fun, .rk.watched.symbols, ...)
f <- .rk.make.watch.f (sym)
- .rk.makeActiveBinding.default (sym, f, globalenv (), ...)
+ .rk.makeActiveBinding.default ("x", fun, environment(f), ...)
+ ret <- .rk.makeActiveBinding.default (sym, f, globalenv ())
+ .rk.watched.symbols[[sym]] <- TRUE
+ invisible(ret)
} else {
.rk.makeActiveBinding.default (sym, fun, env, ...)
}
diff --git a/rkward/rbackend/rpackages/rkward/R/internal.R b/rkward/rbackend/rpackages/rkward/R/internal.R
index de8b64cf..76071519 100644
--- a/rkward/rbackend/rpackages/rkward/R/internal.R
+++ b/rkward/rbackend/rpackages/rkward/R/internal.R
@@ -223,7 +223,6 @@
#}
# these functions can be used to track assignments to R objects. The main interfaces are .rk.watch.symbol (k) and .rk.unwatch.symbol (k). This works by copying the symbol to a local environment, removing it, and replacing it by an active binding to the backup location
-#' @export
".rk.watched.symbols" <- new.env ()
#' @export
@@ -234,18 +233,15 @@
# due to the call to "if (!missing(value))".
missing <- base::missing
.Call <- base::.Call
- invisible <- base::invisible
+ # NOTE: - Another _small_ speedup (~10%) _could_ be achieved by pre-compiling the returned function (compiler::cmpfun()).
+ # - Limiting the .Call()s (by keeping/clearing a flag of whether change has been signalled, before) does not have any measurable effect, but adds complexity
function (value) {
- if (!missing (value)) {
- x <<- value
- .Call ("rk.do.command", c ("ws", k), PACKAGE="(embedding)");
-# NOTE: the above is essentially the same as
-# .rk.do.call ("ws", k);
-# only minimally faster.
- invisible (x)
- } else {
+ if (missing (value)) {
x
+ } else {
+ .Call ("ws", k, PACKAGE="(embedding)");
+ x <<- value
}
}
}
diff --git a/tests/rkward_application_tests.R b/tests/rkward_application_tests.R
index 4f0c253d..1085f7b7 100644
--- a/tests/rkward_application_tests.R
+++ b/tests/rkward_application_tests.R
@@ -20,7 +20,7 @@ suite <- new ("RKTestSuite", id="rkward_application_tests",
.GlobalEnv$active.binding.value <- 123
stopifnot (.GlobalEnv$active.binding == 123)
- stopifnot (bindingIsActive ("active.binding", rkward::.rk.watched.symbols))
+ stopifnot (isTRUE(rkward:::.rk.watched.symbols$active.binding))
# NOTE: the message "active.binding" should be displayed in the message output
}),
More information about the rkward-tracker
mailing list