[rkward-cvs] SF.net SVN: rkward: [795] trunk/rkward/rkward
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Tue Oct 3 11:24:17 UTC 2006
Revision: 795
http://svn.sourceforge.net/rkward/?rev=795&view=rev
Author: tfry
Date: 2006-10-03 04:24:07 -0700 (Tue, 03 Oct 2006)
Log Message:
-----------
Deal with EnvironmentVars (saner handling of Environments, limit recursion)
Modified Paths:
--------------
trunk/rkward/rkward/core/rcontainerobject.cpp
trunk/rkward/rkward/core/renvironmentobject.cpp
trunk/rkward/rkward/core/renvironmentobject.h
trunk/rkward/rkward/core/robjectlist.cpp
trunk/rkward/rkward/rbackend/rdata.cpp
trunk/rkward/rkward/rbackend/rdata.h
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
Modified: trunk/rkward/rkward/core/rcontainerobject.cpp
===================================================================
--- trunk/rkward/rkward/core/rcontainerobject.cpp 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/core/rcontainerobject.cpp 2006-10-03 11:24:07 UTC (rev 795)
@@ -22,6 +22,7 @@
#include "robjectlist.h"
#include "rkvariable.h"
#include "rfunctionobject.h"
+#include "renvironmentobject.h"
#include "../rkglobals.h"
#include "rkmodificationtracker.h"
@@ -51,8 +52,9 @@
return child;
} else {
if (just_created) {
+ RK_ASSERT (false);
+ RK_DO (qDebug (child->getFullName ().latin1 ()), OBJECTS, DL_ERROR);
delete child;
- RK_ASSERT (false);
return 0;
} else {
if (RKGlobals::tracker ()->removeObject (child, 0, true)) {
@@ -77,14 +79,18 @@
if (!RObject::updateStructure (new_data)) return false;
+ RData *children_sub = 0;
if (data_length > 5) {
RK_ASSERT (data_length == 6);
- RData *children_sub = new_data->getStructureVector ()[5];
+ children_sub = new_data->getStructureVector ()[5];
RK_ASSERT (children_sub->getDataType () == RData::StructureVector);
-
- updateChildren (children_sub);
+ } else {
+ // create an empty dummy structure to make sure existing children are removed
+ children_sub = new RData;
+ children_sub->datatype = RData::StructureVector;
}
+ updateChildren (children_sub);
return true;
}
@@ -102,12 +108,18 @@
int child_type = type_data->getIntVector ()[0];
RObject *child_object;
- if (child_type & RObject::Container) {
+ if (child_type & RObject::Environment) {
+ child_object = new REnvironmentObject (this, child_name);
+ static_cast<REnvironmentObject *> (child_object)->namespace_name = makeChildName (child_name);
+ } else if (child_type & RObject::Container) {
child_object = new RContainerObject (this, child_name);
} else if (child_type & RObject::Function) {
child_object = new RFunctionObject (this, child_name);
+ } else if (child_type & RObject::Variable) {
+ child_object = new RKVariable (this, child_name);
} else {
- child_object = new RKVariable (this, child_name);
+ RK_DO (qDebug ("Can't represent object '%s', type %d", child_name.latin1 (), child_type), OBJECTS, DL_WARNING);
+ return 0;
}
RK_ASSERT (child_object);
RKGlobals::tracker ()->lockUpdates (true); // object not yet added. prevent updates
Modified: trunk/rkward/rkward/core/renvironmentobject.cpp
===================================================================
--- trunk/rkward/rkward/core/renvironmentobject.cpp 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/core/renvironmentobject.cpp 2006-10-03 11:24:07 UTC (rev 795)
@@ -61,18 +61,35 @@
void REnvironmentObject::updateFromR () {
RK_TRACE (OBJECTS);
+ QString envlevel;
+ if (type & GlobalEnv) envlevel = ", -1"; // in the .GlobalEnv recurse one more level
- RCommand *command = new RCommand (".rk.get.environment.structure (" + getFullName () + ")", RCommand::App | RCommand::Sync | RCommand::GetStructuredData, QString::null, this, ROBJECT_UDPATE_STRUCTURE_COMMAND);
+ RCommand *command = new RCommand (".rk.get.structure (" + getFullName () + ", " + rQuote (getShortName ()) + envlevel + ")", RCommand::App | RCommand::Sync | RCommand::GetStructuredData, QString::null, this, ROBJECT_UDPATE_STRUCTURE_COMMAND);
RKGlobals::rInterface ()->issueCommand (command, RObjectList::getObjectList ()->getUpdateCommandChain ());
}
bool REnvironmentObject::updateStructure (RData *new_data) {
RK_TRACE (OBJECTS);
RK_ASSERT (new_data->getDataType () == RData::StructureVector);
+ RK_ASSERT (new_data->getDataLength () >= 5);
-// if (!RObject::updateStructure (new_data)) return false; // this is an environment object. nothing to update
- updateChildren (new_data); // children are directly in the structure
+ if (type & EnvironmentVar) {
+ if (!RObject::updateStructure (new_data)) return false;
+ }
+ RData *children_sub = 0;
+ if (new_data->getDataLength () > 5) {
+ RK_ASSERT (new_data->getDataLength () == 6);
+
+ children_sub = new_data->getStructureVector ()[5];
+ RK_ASSERT (children_sub->getDataType () == RData::StructureVector);
+ } else {
+ // create an empty dummy structure to make sure existing children are removed
+ children_sub = new RData;
+ children_sub->datatype = RData::StructureVector;
+ }
+ updateChildren (children_sub);
+
return true;
}
Modified: trunk/rkward/rkward/core/renvironmentobject.h
===================================================================
--- trunk/rkward/rkward/core/renvironmentobject.h 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/core/renvironmentobject.h 2006-10-03 11:24:07 UTC (rev 795)
@@ -65,6 +65,7 @@
*/
protected:
friend class RObjectList;
+ friend class RContainerObject;
bool updateStructure (RData *new_data);
/** reimplemented from RContainerObject to raise an assert if this is not the isGlobalEnv (). Otherwise calls "remove (objectname)" instead of objectname <- NULL" */
void renameChild (RObject *object, const QString &new_name);
Modified: trunk/rkward/rkward/core/robjectlist.cpp
===================================================================
--- trunk/rkward/rkward/core/robjectlist.cpp 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/core/robjectlist.cpp 2006-10-03 11:24:07 UTC (rev 795)
@@ -160,6 +160,7 @@
} else if (name.contains (':')) {
envobj->namespace_name = name.section (':', 1);
} else if (name == "Autoloads") {
+#warning HACK, wrong
envobj->type |= GlobalEnv; // this is wrong! but it's a temporary HACK to get things to work
}
Modified: trunk/rkward/rkward/rbackend/rdata.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rdata.cpp 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/rbackend/rdata.cpp 2006-10-03 11:24:07 UTC (rev 795)
@@ -89,3 +89,40 @@
from->detachData ();
delete from;
}
+
+void RData::printStructure (const QString &prefix) {
+ switch (datatype) {
+ case NoData:
+ qDebug ("%s: NoData, length %d", prefix.latin1(), length);
+ break;
+ case IntVector:
+ qDebug ("%s: IntVector, length %d", prefix.latin1(), length);
+ for (unsigned int i = 0; i < length; ++i) {
+ qDebug ("%s%d: %d", prefix.latin1(), i, getIntVector ()[i]);
+ }
+ break;
+ case RealVector:
+ qDebug ("%s: RealVector, length %d", prefix.latin1(), length);
+ for (unsigned int i = 0; i < length; ++i) {
+ qDebug ("%s%d: %f", prefix.latin1(), i, getRealVector ()[i]);
+ }
+ break;
+ case StringVector:
+ qDebug ("%s: StringVector, length %d", prefix.latin1(), length);
+ for (unsigned int i = 0; i < length; ++i) {
+ qDebug ("%s%d: %s", prefix.latin1(), i, getStringVector ()[i].latin1());
+ }
+ break;
+ case StructureVector:
+ qDebug ("%s: StructureVector, length %d", prefix.latin1(), length);
+ for (unsigned int i = 0; i < length; ++i) {
+ QString sub_prefix = prefix + QString::number (i);
+ getStructureVector ()[i]->printStructure (sub_prefix);
+ }
+ break;
+ default:
+ qDebug ("%s: INVALID %d, length %d", prefix.latin1(), datatype, length);
+ }
+ qDebug ("%s: END\n\n", prefix.latin1 ());
+}
+
Modified: trunk/rkward/rkward/rbackend/rdata.h
===================================================================
--- trunk/rkward/rkward/rbackend/rdata.h 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/rbackend/rdata.h 2006-10-03 11:24:07 UTC (rev 795)
@@ -47,6 +47,8 @@
/** The data contained in the RData structure is owned by RData, and will usually be deleted at the end of the lifetime of the RData object. If you want to keep the data, call detachData () to prevent this deletion. You will be responsible for deletion of the data yourself. */
void detachData ();
void discardData ();
+/** purely for debugging! */
+ void printStructure (const QString &prefix);
/** public for technical reasons only. Do not use! Copy data from the given RData, and discard it */
void setData (RData *from);
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2006-10-02 22:37:25 UTC (rev 794)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2006-10-03 11:24:07 UTC (rev 795)
@@ -271,7 +271,7 @@
invisible (TRUE)
}
-".rk.get.structure" <- function (x, name) {
+".rk.get.structure" <- function (x, name, envlevel=0) {
fun <- FALSE
cont <- FALSE
type <- 0
@@ -295,7 +295,10 @@
fun <- TRUE
type = 128
}
- if (is.environment (x)) type = 256
+ if (is.environment (x)) {
+ type = 256
+ cont <- TRUE
+ }
if (!is.null (attr (x, ".rk.meta"))) type = type + 2048
ret$type <- as.integer (type)
@@ -315,15 +318,19 @@
# 6: Special info valid for some objects ony. This should always be last in the returned structure, as the number of fields may vary
if (cont) { # a container
- nms <- names (x)
- if (!is.null (nms)) {
- i <- 0
- sub <- list ()
- for (child in x) {
- i <- i+1
- sub[[nms[i]]] <- .rk.get.structure (child, nms[i])
+ if (is.environment (x)) {
+ ret$sub <- .rk.get.environment.children (x, envlevel+1)
+ } else {
+ nms <- names (x)
+ if (!is.null (nms)) {
+ i <- 0
+ sub <- list ()
+ for (child in x) {
+ i <- i+1
+ sub[[nms[i]]] <- .rk.get.structure (child, nms[i])
+ }
+ ret$sub <- sub
}
- ret$sub <- sub
}
} else if (fun) { # a function
ret$argnames <- as.character (names (formals (x)))
@@ -333,12 +340,14 @@
ret
}
-".rk.get.environment.structure" <- function (x) {
+".rk.get.environment.children" <- function (x, envlevel=0) {
ret <- list ()
- lst <- ls (x, all.names=TRUE)
- for (childname in lst) {
- ret[[childname]] <- .rk.get.structure (get (childname, envir=x), childname)
+ if (envlevel < 2) { # prevent infinite recursion
+ lst <- ls (x, all.names=TRUE)
+ for (childname in lst) {
+ ret[[childname]] <- .rk.get.structure (get (childname, envir=x), childname, envlevel)
+ }
}
ret
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