[education/rkward] rkward/rbackend: Start working on a new object modification detection scheme.

[Thomas Friedrichsmeier]

Git commit 072be5d5e417031dde18f648c73f0a7ad77cd4ac by Thomas Friedrichsmeier.
Committed on 23/05/2020 at 16:56.
Pushed by tfry into branch 'master'.

Start working on a new object modification detection scheme.

Based on shadow copies, rather than active bindings, as the latter are slow, and broken in R 4.0.0.

M  +5    -0    rkward/rbackend/rkrbackend.cpp
M  +59   -0    rkward/rbackend/rkrsupport.cpp
M  +12   -0    rkward/rbackend/rkrsupport.h

https://invent.kde.org/education/rkward/commit/072be5d5e417031dde18f648c73f0a7ad77cd4ac

diff --git a/rkward/rbackend/rkrbackend.cpp b/rkward/rbackend/rkrbackend.cpp
index f4e36128..11da3242 100644
--- a/rkward/rbackend/rkrbackend.cpp
+++ b/rkward/rbackend/rkrbackend.cpp
@@ -1046,6 +1046,10 @@ SEXP RKD_AdjustSize (SEXP devnum);
 SEXP doWs (SEXP name);
 void doPendingPriorityCommands ();
 
+SEXP checkEnv(SEXP a) {
+	return RKRSupport::StringListToSEXP(RKRShadowEnvironment::environmentFor(a)->diffAndUpdate());
+}
+
 bool RKRBackend::startR () {
 	RK_TRACE (RBACKEND);
 
@@ -1134,6 +1138,7 @@ bool RKRBackend::startR () {
 		{ "rk.capture.output", (DL_FUNC) (void*) &doCaptureOutput, 5 },
 		{ "rk.graphics.device", (DL_FUNC) (void*) &RKStartGraphicsDevice, 7},
 		{ "rk.graphics.device.resize", (DL_FUNC) (void*) &RKD_AdjustSize, 1},
+		{ "rk.check.env", (DL_FUNC) (void*) &checkEnv, 1 },
 		{ 0, 0, 0 }
 	};
 	R_registerRoutines (R_getEmbeddingDllInfo(), NULL, callMethods, NULL, NULL);
diff --git a/rkward/rbackend/rkrsupport.cpp b/rkward/rbackend/rkrsupport.cpp
index ee039454..97a39335 100644
--- a/rkward/rbackend/rkrsupport.cpp
+++ b/rkward/rbackend/rkrsupport.cpp
@@ -248,3 +248,62 @@ RData *RKRSupport::SEXPToRData (SEXP from_exp) {
 
 	return data;
 }
+
+QMap<SEXP, RKRShadowEnvironment*> RKRShadowEnvironment::environments;
+RKRShadowEnvironment* RKRShadowEnvironment::environmentFor(SEXP baseenvir) {
+	if (!environments.contains(baseenvir)) {
+		// TODO: Of course this is still wrong!
+Rprintf("new shadow environment for %p\n", baseenvir);
+	SEXP tr = Rf_allocVector(INTSXP, 1);
+	INTEGER (tr)[0] = TRUE;
+		Rf_defineVar(Rf_install("shadow_hide_me"), RKRSupport::callSimpleFun2(Rf_install("new.env"), tr, R_EmptyEnv, R_GlobalEnv), R_GlobalEnv);
+		SEXP shadowenvir = Rf_findVar(Rf_install("shadow_hide_me"), R_GlobalEnv);
+		environments.insert(baseenvir, new RKRShadowEnvironment(baseenvir, shadowenvir));
+	}
+	return environments[baseenvir];
+}
+
+QStringList RKRShadowEnvironment::diffAndUpdate() {
+	QStringList diffs;
+	QStringList removed;
+
+	Rprintf("%p %p\n", baseenvir, shadowenvir);
+	// find the changed symbols, and copy them to the shadow environment
+	SEXP symbols = R_lsInternal(baseenvir, TRUE);
+	PROTECT(symbols);
+	int count = Rf_length(symbols);
+	for (int i = 0; i < count; ++i) {
+		SEXP name = Rf_installChar(STRING_ELT(symbols, i));
+		PROTECT(name);
+		SEXP main = Rf_findVar(name, baseenvir);
+		SEXP cached = Rf_findVar(name, shadowenvir);
+		if (main != cached) {
+			Rf_defineVar(name, Rf_findVar(name, baseenvir), shadowenvir);
+			diffs.append(RKRSupport::SEXPToString(name));
+		}
+		UNPROTECT(1);
+	}
+
+	// find the symbols only in the shadow environment (those that were removed)
+	SEXP symbols2 = R_lsInternal(shadowenvir, TRUE);
+	PROTECT(symbols2);
+	int count2 = Rf_length (symbols2);
+	for (int i = 0; i < count2; ++i) {
+		bool found = false;
+		for (int j = 0; j < count; ++j) {
+			if (STRING_ELT(symbols, j) == STRING_ELT(symbols2, i)) {
+				found = true;
+				break;
+			}
+		}
+		if (!found) {
+			removed.append(RKRSupport::SEXPToString(Rf_installChar(STRING_ELT(symbols2, i))));
+		}
+	}
+
+	UNPROTECT(2);
+
+	Rprintf("changed %s\n", qPrintable(diffs.join(", ")));
+	Rprintf("removed %s\n", qPrintable(removed.join(", ")));
+	return diffs + removed;
+}
diff --git a/rkward/rbackend/rkrsupport.h b/rkward/rbackend/rkrsupport.h
index d5eb3ac2..c73920ef 100644
--- a/rkward/rbackend/rkrsupport.h
+++ b/rkward/rbackend/rkrsupport.h
@@ -43,4 +43,16 @@ namespace RKRSupport {
 	RData* SEXPToRData (SEXP from_exp);
 };
 
+class RKRShadowEnvironment {
+public:
+	QStringList diffAndUpdate();
+	static RKRShadowEnvironment* environmentFor(SEXP baseenvir);
+private:
+	RKRShadowEnvironment(SEXP baseenvir, SEXP shadowenvir) : baseenvir(baseenvir), shadowenvir(shadowenvir) {};
+	~RKRShadowEnvironment();
+	SEXP baseenvir;
+	SEXP shadowenvir;
+	static QMap<SEXP, RKRShadowEnvironment*> environments;
+};
+
 #endif