[rkward-cvs] SF.net SVN: rkward: [811] trunk/rkward/rkward/rbackend
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Thu Oct 5 14:25:30 UTC 2006
Revision: 811
http://svn.sourceforge.net/rkward/?rev=811&view=rev
Author: tfry
Date: 2006-10-05 07:25:23 -0700 (Thu, 05 Oct 2006)
Log Message:
-----------
Objectlist auto updates part 2: Use active bindings to detect changed symbols
Modified Paths:
--------------
trunk/rkward/rkward/rbackend/rembedinternal.cpp
trunk/rkward/rkward/rbackend/rinterface.cpp
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
trunk/rkward/rkward/rbackend/rthread.cpp
trunk/rkward/rkward/rbackend/rthread.h
Modified: trunk/rkward/rkward/rbackend/rembedinternal.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.cpp 2006-10-05 12:48:45 UTC (rev 810)
+++ trunk/rkward/rkward/rbackend/rembedinternal.cpp 2006-10-05 14:25:23 UTC (rev 811)
@@ -64,87 +64,6 @@
#include "../rkglobals.h"
#include "rdata.h"
-#ifdef REMBEDINTERNALEXPERIMENTAL
-// code mostly copied from RObjectTables
-SEXP RealGlobalEnv;
-
-Rboolean fakeRGlobalEnv_exists (const char * const name, Rboolean *canCache, R_ObjectTable *tb) {
- *canCache = (Rboolean) FALSE;
- Rprintf ("exists");
-}
-
-SEXP fakeRGlobalEnv_get (const char * const name, Rboolean *canCache, R_ObjectTable *tb) {
- Rprintf ("get");
- return (R_NilValue);
-}
-
-int fakeRGlobalEnv_remove (const char * const name, R_ObjectTable *tb) {
- Rprintf ("remove");
- return 0;
-}
-
-Rboolean fakeRGlobalEnv_canCache (const char * const name, R_ObjectTable *tb) {
- return ((Rboolean) FALSE);
-}
-
-SEXP fakeRGlobalEnv_assign (const char * const name, SEXP value, R_ObjectTable *tb) {
- Rprintf ("assign");
- return (R_NilValue);
-}
-
-SEXP fakeRGlobalEnv_objects (R_ObjectTable *tb) {
- Rprintf ("objects");
- return (R_NilValue);
-}
-
-void createFakeRGlobalEnv ()
-{
- R_ObjectTable *tb;
- SEXP val, klass;
-
- tb = (R_ObjectTable *) malloc(sizeof(R_ObjectTable));
- if(!tb)
- error("cannot allocate space for an internal R object table");
-
- tb->type = 15;
- tb->cachedNames = NULL;
- tb->active = (Rboolean) TRUE;
-
- R_PreserveObject (R_GlobalEnv);
- tb->privateData = R_GlobalEnv;
-
- tb->exists = fakeRGlobalEnv_exists;
- tb->get = fakeRGlobalEnv_get;
- tb->remove = fakeRGlobalEnv_remove;
- tb->assign = fakeRGlobalEnv_assign;
- tb->objects = fakeRGlobalEnv_objects;
- tb->canCache = fakeRGlobalEnv_canCache;
-
- tb->onAttach = NULL;
- tb->onDetach = NULL;
-
- PROTECT(val = R_MakeExternalPtr(tb, Rf_install("UserDefinedDatabase"), R_NilValue));
- PROTECT(klass = NEW_CHARACTER(1));
- SET_STRING_ELT(klass, 0, COPY_TO_USER_STRING("UserDefinedDatabase"));
- SET_CLASS(val, klass);
- UNPROTECT(2);
-
- RealGlobalEnv = R_GlobalEnv;
-
- SEXP s = allocSExp(ENVSXP);
- SET_HASHTAB(s, CAR (val));
- setAttrib(s, R_ClassSymbol, getAttrib(HASHTAB(s), R_ClassSymbol));
- setAttrib(s, install("name"), install ("test"));
-
-// SET_ENCLOS (val, RealGlobalEnv);
-// R_GlobalEnv = val;
- SEXP x = ENCLOS(R_GlobalEnv);
- SET_ENCLOS(R_GlobalEnv, s);
- SET_ENCLOS(s, x);
-MARK_AS_GLOBAL_FRAME(s);
-}
-#endif
-
// ############## R Standard callback overrides BEGIN ####################
void RSuicide (char* message) {
RCallbackArgs args;
Modified: trunk/rkward/rkward/rbackend/rinterface.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rinterface.cpp 2006-10-05 12:48:45 UTC (rev 810)
+++ trunk/rkward/rkward/rbackend/rinterface.cpp 2006-10-05 14:25:23 UTC (rev 811)
@@ -169,6 +169,19 @@
RK_DO (qDebug ("triggering update of globalenv"), RBACKEND, DL_DEBUG);
// TODO: maybe this should be put inside a chain
RObjectList::getGlobalEnv ()->updateFromR ();
+ } else if ((e->type () == RINDIVIDUAL_SYMBOLS_CHANGED_EVENT)) {
+ RK_DO (qDebug ("triggering update of some symbols"), RBACKEND, DL_DEBUG);
+ QStringList *list = static_cast <QStringList *> (e->data ());
+ for (QStringList::const_iterator it = list->constBegin (); it != list->constEnd (); ++it) {
+ RObject *obj = RObjectList::getGlobalEnv ()->findObject (*it);
+ if (obj) {
+ // TODO: maybe this should be put inside a chain
+ obj->updateFromR ();
+ } else {
+ RK_DO (qDebug ("lookup failed for changed symbol %s", (*it).latin1 ()), RBACKEND, DL_WARNING);
+ }
+ }
+ delete list;
} else if ((e->type () == R_EVAL_REQUEST_EVENT)) {
r_thread->pauseOutput (false); // we may be recursing downwards into event loops here. Hence we need to make sure, we don't create a deadlock
processREvalRequest (static_cast<REvalRequest *> (e->data ()));
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2006-10-05 12:48:45 UTC (rev 810)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2006-10-05 14:25:23 UTC (rev 811)
@@ -204,51 +204,58 @@
}
# these functions (not fully functional, yet) 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 backup location, removing it, and replacing it by an active binding to the backup location
-.rk.watched.value.change <- function (k, value) {
- print (paste ("set", as.character(k)))
- .rk.watched.symbols[[as.character(k)]] <<- value
-}
-.rk.watched.value.retrieve <- function (k) {
- print (paste ("ret", as.character(k)))
- .rk.watched.symbols[[as.character(k)]]
-}
+".rk.watched.symbols" <- new.env ()
-.rk.make.watch.f <- function (k) {
+".rk.make.watch.f" <- function (k) {
function (value) {
if (!missing (value)) {
- .rk.watched.value.change (k, value)
+ assign (k, value, envir=.rk.watched.symbols)
+ .rk.do.call ("ws", k);
invisible (value)
+ } else {
+ get (k, envir=.rk.watched.symbols)
}
- else {
- .rk.watched.value.retrieve (k)
- }
}
}
-.rk.watch.symbol <- function (k) {
- f <- .rk.make.watch.f (substitute (k))
- if (!exists (".rk.watched.symbols")) .rk.watched.symbols <<- list ()
- .rk.watched.symbols[[as.character (substitute (k))]] <<- k
- lst <- c (substitute (k))
- rm (list=as.character (lst), envir=parent.frame ())
+".rk.watch.symbol" <- function (k) {
+ f <- .rk.make.watch.f (k)
+ assign (k, get (k, envir=globalenv ()), envir=.rk.watched.symbols)
+ rm (list=k, envir=globalenv ())
- makeActiveBinding (substitute (k), f, parent.frame ())
+ makeActiveBinding (k, f, globalenv ())
invisible (TRUE)
}
-.rk.unwatch.symbol <- function (k) {
- lst <- c (substitute (k))
- rm (list=as.character (lst), envir=parent.frame ())
+# not needed by rkward
+".rk.unwatch.symbol" <- function (k) {
+ rm (list=k, envir=globalenv ())
- eval (substitute (k <<- .rk.watched.symbols[[as.character (substitute (k))]]))
+ k <<- .rk.watched.symbols$k
- .rk.watched.symbols[as.character(substitute (k))] <<- NULL
+ rm (k, envir=.rk.watched.symbols);
invisible (TRUE)
}
+".rk.watch.globalenv" <- function () {
+ newlist <- ls (globalenv (), all.names=TRUE)
+ oldlist <- ls (.rk.watched.symbols, all.names=TRUE)
+ for (old in oldlist) { # unwatch no longer present items
+ if (!(old %in% newlist)) {
+ rm (old, envir=.rk.watched.symbols);
+ }
+ }
+
+ for (new in newlist) { # watch new items
+ if (!(new %in% oldlist)) {
+ .rk.watch.symbol (new)
+ }
+ }
+}
+
".rk.get.structure" <- function (x, name, envlevel=0, namespacename=NULL, misplaced=FALSE) {
fun <- FALSE
cont <- FALSE
Modified: trunk/rkward/rkward/rbackend/rthread.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rthread.cpp 2006-10-05 12:48:45 UTC (rev 810)
+++ trunk/rkward/rkward/rbackend/rthread.cpp 2006-10-05 14:25:23 UTC (rev 811)
@@ -213,9 +213,7 @@
}
// step 3: cleanup
- if (command->type () & RCommand::User) {
- checkObjectUpdatesNeeded ();
- }
+ checkObjectUpdatesNeeded (command->type () & RCommand::User);
// notify GUI-thread that command was finished
event = new QCustomEvent (RCOMMAND_OUT_EVENT);
@@ -313,6 +311,13 @@
void RThread::handleSubstackCall (QString *call, int call_length) {
RK_TRACE (RBACKEND);
+ if (call_length == 2) { // schedule symbol update for later
+ if (call[0] == "ws") {
+ if (!changed_symbol_names.contains (call[1])) changed_symbol_names.append (call[1]);
+ return;
+ }
+ }
+
RCommand *prev_command = current_command;
REvalRequest *request = new REvalRequest;
request->call = call;
@@ -437,7 +442,7 @@
if (error) status |= OtherFail;
// TODO: error-handling?
- checkObjectUpdatesNeeded ();
+ checkObjectUpdatesNeeded (true);
MUTEX_LOCK;
flushOutput ();
@@ -449,62 +454,80 @@
return status;
}
-void RThread::checkObjectUpdatesNeeded () {
+void RThread::checkObjectUpdatesNeeded (bool check_list) {
RK_TRACE (RBACKEND);
- RKWardRError error;
- unsigned int count;
- QString *strings;
+ /* NOTE: We're keeping separate lists of the items on the search path, and the toplevel symbols in .GlobalEnv here.
+ This info is also present in RObjectList (and it's children). However: a) in a less convenient form, b) in the other thread. To avoid locking, and other complexity, keeping separate lists seems an ok solution. Keep in mind that only the names of only the toplevel objects are kept, here, so the memory overhead should be minimal */
bool search_update_needed = false;
bool globalenv_update_needed = false;
+ RKWardRError error;
-// TODO: avoid parsing this over and over again
- strings = getCommandAsStringVector ("search ()\n", &count, &error);
- if (count != toplevel_env_count) {
- search_update_needed = true;
- } else {
- for (unsigned int i = 0; i < toplevel_env_count; ++i) {
- if (toplevel_env_names[i] != strings[i]) {
- search_update_needed = true;
- break;
+ if (check_list) {
+ unsigned int count;
+ QString *strings;
+
+ // TODO: avoid parsing this over and over again
+ strings = getCommandAsStringVector ("search ()\n", &count, &error);
+ if (count != toplevel_env_count) {
+ search_update_needed = true;
+ } else {
+ for (unsigned int i = 0; i < toplevel_env_count; ++i) {
+ if (toplevel_env_names[i] != strings[i]) {
+ search_update_needed = true;
+ break;
+ }
}
}
- }
- delete [] toplevel_env_names;
- toplevel_env_names = strings;
- toplevel_env_count = count;
-
-// TODO: avoid parsing this over and over again
- strings = getCommandAsStringVector ("ls (globalenv (), all.names=TRUE)\n", &count, &error);
- if (count != global_env_toplevel_count) {
- globalenv_update_needed = true;
- } else {
- for (unsigned int i = 0; i < global_env_toplevel_count; ++i) {
- bool found = false;
- for (unsigned int j = 0; j < global_env_toplevel_count; ++j) {
- if (global_env_toplevel_names[j] == strings[i]) {
- found = true;
+ delete [] toplevel_env_names;
+ toplevel_env_names = strings;
+ toplevel_env_count = count;
+
+ // TODO: avoid parsing this over and over again
+ strings = getCommandAsStringVector ("ls (globalenv (), all.names=TRUE)\n", &count, &error);
+ if (count != global_env_toplevel_count) {
+ globalenv_update_needed = true;
+ } else {
+ for (unsigned int i = 0; i < global_env_toplevel_count; ++i) {
+ bool found = false;
+ for (unsigned int j = 0; j < global_env_toplevel_count; ++j) {
+ if (global_env_toplevel_names[j] == strings[i]) {
+ found = true;
+ break;
+ }
+ }
+ if (!found) {
+ globalenv_update_needed = true;
break;
}
}
- if (!found) {
- globalenv_update_needed = true;
- break;
- }
}
+ delete [] global_env_toplevel_names;
+ global_env_toplevel_names = strings;
+ global_env_toplevel_count = count;
+
+ if (search_update_needed) { // this includes an update of the globalenv, even if not needed
+ QCustomEvent *event = new QCustomEvent (RSEARCHLIST_CHANGED_EVENT);
+ qApp->postEvent (RKGlobals::rInterface (), event);
+ } else if (globalenv_update_needed) {
+ QCustomEvent *event = new QCustomEvent (RGLOBALENV_SYMBOLS_CHANGED_EVENT);
+ qApp->postEvent (RKGlobals::rInterface (), event);
+ }
}
- delete [] global_env_toplevel_names;
- global_env_toplevel_names = strings;
- global_env_toplevel_count = count;
- if (search_update_needed) { // this includes an update of the globalenv, even if not needed
- QCustomEvent *event = new QCustomEvent (RSEARCHLIST_CHANGED_EVENT);
- qApp->postEvent (RKGlobals::rInterface (), event);
- } else if (globalenv_update_needed) {
- QCustomEvent *event = new QCustomEvent (RGLOBALENV_SYMBOLS_CHANGED_EVENT);
- qApp->postEvent (RKGlobals::rInterface (), event);
+ if (search_update_needed || globalenv_update_needed) {
+ runCommandInternal (".rk.watch.globalenv ()\n", &error);
+ } else {
+ if (!changed_symbol_names.isEmpty ()) {
+ QStringList *copy = new QStringList (changed_symbol_names);
+ QCustomEvent *event = new QCustomEvent (RINDIVIDUAL_SYMBOLS_CHANGED_EVENT);
+ event->setData (copy);
+ qApp->postEvent (RKGlobals::rInterface (), event);
+ }
}
+
+ changed_symbol_names.clear ();
}
QString *stringsToStringList (char **strings, int count) {
Modified: trunk/rkward/rkward/rbackend/rthread.h
===================================================================
--- trunk/rkward/rkward/rbackend/rthread.h 2006-10-05 12:48:45 UTC (rev 810)
+++ trunk/rkward/rkward/rbackend/rthread.h 2006-10-05 14:25:23 UTC (rev 811)
@@ -18,6 +18,7 @@
#define RTHREAD_H
#include <qthread.h>
+#include <qstringlist.h>
#include "rcommand.h"
#include "rcommandstack.h"
@@ -39,6 +40,7 @@
#define RSTARTUP_ERROR_EVENT 13000
#define RSEARCHLIST_CHANGED_EVENT 14000
#define RGLOBALENV_SYMBOLS_CHANGED_EVENT 14001
+#define RINDIVIDUAL_SYMBOLS_CHANGED_EVENT 14002
/** This class represents the thread the R backend is running in. So to speak, this is where the "eventloop" of R is running. The main thing happening
in this class, is that an infinite loop is running. Whenever there are commands to be executed, those get evaluated. Also, at regular intervals,
@@ -176,7 +178,8 @@
unsigned int toplevel_env_count;
QString *global_env_toplevel_names;
unsigned int global_env_toplevel_count;
- void checkObjectUpdatesNeeded ();
+ QStringList changed_symbol_names;
+ void checkObjectUpdatesNeeded (bool check_list);
};
#endif
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the rkward-tracker
mailing list