[rkward-cvs] SF.net SVN: rkward: [1810] trunk/rkward/rkward/rbackend
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Wed Apr 11 19:32:44 UTC 2007
Revision: 1810
http://svn.sourceforge.net/rkward/?rev=1810&view=rev
Author: tfry
Date: 2007-04-11 12:32:43 -0700 (Wed, 11 Apr 2007)
Log Message:
-----------
Cleanups and (minimal) progress regarding .rk.get.structure() rework
Modified Paths:
--------------
trunk/rkward/rkward/rbackend/rembedinternal.cpp
Added Paths:
-----------
trunk/rkward/rkward/rbackend/rkstructuregetter.cpp
trunk/rkward/rkward/rbackend/rkstructuregetter.h
Modified: trunk/rkward/rkward/rbackend/rembedinternal.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.cpp 2007-04-11 18:36:59 UTC (rev 1809)
+++ trunk/rkward/rkward/rbackend/rembedinternal.cpp 2007-04-11 19:32:43 UTC (rev 1810)
@@ -627,97 +627,14 @@
return R_NilValue;
}
-RData *getStructureWorker (SEXP value, SEXP name, SEXP namespacename, int envlevel, bool misplaced) {
- bool is_function = false;
- bool is_container = false;
- unsigned int type = 0;
- unsigned int count;
- SEXP call;
+#include "rkstructuregetter.cpp"
- // TODO: move all this logic to a separate file
- // TODO: instead of returning an RData, take the parent as parameter, and add to that. Why? Because this way we can tie up all the data earlier. Then, if there is an error (hopefully, there isn't, of course), most memory can be released easily, without the need for much bookkeeping).
-
- // TODO: make name parameter a const QString&
- // TODO: can namespacename be pre-resolved to a namespace environment? Not that it should matter too much, as it is only needed when recursing into environments, and only once per env.
-
- // TODO: manually resolve promises
-
- // first field: get name
- RData *namedata = new RData;
- namedata->data = SEXPToStringList (name, &count);
- namedata->datatype = RData::StringVector;
-
- // get classes (note that those are the third element in the RData for historical reasons, but we need to fetch them earlier, in order to find out, whether an object is a data.frame.
- // TODO: resolve function "class_fun" only once
- SEXP class_fun = Rf_findFun (Rf_install ("class"), R_BaseEnv);;
- PROTECT (class_fun);
-
- call = allocVector (LANGSXP, 2);
- PROTECT (call);
- SETCAR (call, class_fun);
- SETCAR (CDR (call), value);
- SEXP classes_s = Rf_eval (call, R_GlobalEnv);
- PROTECT (classes_s);
- QString *classes = SEXPToStringList (classes_s, &count);
- unsigned int num_classes = count;
- UNPROTECT (2); /* classes_s, call */
- UNPROTECT (1); /* class_fun */
-
- // basic classification
- for (unsigned int i = 0; i < num_classes; ++i) {
- if (classes[i] == "data.frame") type |= RObject::DataFrame;
- }
-
- if (Rf_isMatrix (value)) type |= RObject::Matrix;
- if (Rf_isArray (value)) type |= RObject::Array;
- if (Rf_isList (value)) type |= RObject::List;
- if (Rf_isNewList (value)) type |= RObject::List;
-
- if (type != 0) {
- is_container = true;
- } else {
- if (Rf_isFunction (value)) {
- is_function = true;
- type |= RObject::Function;
- } else if (Rf_isEnvironment (value)) {
- is_container = true;
- type |= RObject::Environment;
- } else {
- type |= RObject::Variable;
- if (Rf_isFactor (value)) type |= RObject::Factor;
- else if (Rf_isNumeric (value)) type |= RObject::Numeric;
-//TODO: else if (Rf_isCharacter (value)) type |= RObject::Character;
- else if (Rf_isLogical (value)) type |= RObject::Logical;
- }
- }
- // TODO: does it have a meta attribute?
- // TODO: is it misplaced?
-
- // TODO: set type
-
- // TODO: set classes
-
- // TODO: get and set dims
-
- if (is_container) {
- // TODO: get and set children
- } else if (is_function) {
- // TODO: get and set arguments
- }
-}
-
SEXP doGetStructureTest (SEXP toplevel, SEXP name, SEXP namespacename) {
RK_TRACE (RBACKEND);
- RData *data = getStructureWorker (toplevel, name, namespacename, 2, false);
+ RKStructureGetter getter (false);
+ RData *ret = getter.getStructure (toplevel, name, namespacename);
-/*
- char *cname = (char*) STRING_PTR (VECTOR_ELT (name, 0));
- SEXP val = findVar (install(CHAR(STRING_ELT(name, 0))), envir);
- if (TYPEOF (val) == PROMSXP) {
- qDebug ("name %s, type %d, unbound %d", cname, TYPEOF (val), PRVALUE(val) == R_UnboundValue);
- } */
-
return R_NilValue;
}
Added: trunk/rkward/rkward/rbackend/rkstructuregetter.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rkstructuregetter.cpp (rev 0)
+++ trunk/rkward/rkward/rbackend/rkstructuregetter.cpp 2007-04-11 19:32:43 UTC (rev 1810)
@@ -0,0 +1,142 @@
+/***************************************************************************
+ rkstructuregetter - description
+ -------------------
+ begin : Wed Apr 11 2007
+ copyright : (C) 2007 by Thomas Friedrichsmeier
+ email : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ * *
+ * This program is free software; you can redistribute it and/or modify *
+ * it under the terms of the GNU General Public License as published by *
+ * the Free Software Foundation; either version 2 of the License, or *
+ * (at your option) any later version. *
+ * *
+ ***************************************************************************/
+
+#include "rkstructuregetter.h"
+
+RKStructureGetter::RKStructureGetter (bool keep_evalled_promises) {
+ RK_TRACE (RBACKEND);
+
+ RKStructureGetter::keep_evalled_promises = keep_evalled_promises;
+
+ class_fun = Rf_findFun (Rf_install ("class"), R_BaseEnv);;
+ PROTECT (class_fun);
+
+ meta_attrib = Rf_install (".rk.meta");
+ PROTECT (meta_attrib);
+}
+
+RKStructureGetter::~RKStructureGetter () {
+ RK_TRACE (RBACKEND);
+
+ UNPROTECT (2); /* meta_attrib, class_fun */
+}
+
+RData *RKStructureGetter::getStructure (SEXP toplevel, SEXP name, SEXP namespacename) {
+ RK_TRACE (RBACKEND);
+
+ unsigned int count;
+ QString *name_dummy = SEXPToStringList (name, &count);
+ RK_ASSERT (count == 1);
+ QString name_string = name_dummy[0];
+ delete [] name_dummy;
+
+ // TODO: resolve namespace, if needed
+
+ RData *ret = new RData;
+ // TODO: wrap inside a toplevel exec
+ getStructureWorker (toplevel, name_string, /* TODO */ false, ret);
+
+ return ret;
+
+
+/*
+ char *cname = (char*) STRING_PTR (VECTOR_ELT (name, 0));
+ SEXP val = findVar (install(CHAR(STRING_ELT(name, 0))), envir);
+ if (TYPEOF (val) == PROMSXP) {
+ qDebug ("name %s, type %d, unbound %d", cname, TYPEOF (val), PRVALUE(val) == R_UnboundValue);
+ } */
+
+}
+
+void RKStructureGetter::getStructureWorker (SEXP value, const QString &name, bool misplaced, RData *storage) {
+ RK_TRACE (RBACKEND);
+
+ bool is_function = false;
+ bool is_container = false;
+ unsigned int type = 0;
+ unsigned int count;
+ SEXP call;
+
+ // TODO: move all this logic to a separate file
+ // TODO: instead of returning an RData, take the parent as parameter, and add to that. Why? Because this way we can tie up all the data earlier. Then, if there is an error (hopefully, there isn't, of course), most memory can be released easily, without the need for much bookkeeping).
+
+ // TODO: make name parameter a const QString&
+ // TODO: can namespacename be pre-resolved to a namespace environment? Not that it should matter too much, as it is only needed when recursing into environments, and only once per env.
+
+ // TODO: manually resolve promises
+
+ // first field: get name
+ RData *namedata = new RData;
+ namedata->datatype = RData::StringVector;
+ QString *dummy = new QString[1];
+ dummy[0] = name;
+ namedata->data = dummy;
+
+ // get classes (note that those are the third element in the RData for historical reasons, but we need to fetch them earlier, in order to find out, whether an object is a data.frame.
+ call = allocVector (LANGSXP, 2);
+ PROTECT (call);
+ SETCAR (call, class_fun);
+ SETCAR (CDR (call), value);
+ SEXP classes_s = Rf_eval (call, R_GlobalEnv);
+ PROTECT (classes_s);
+ QString *classes = SEXPToStringList (classes_s, &count);
+ unsigned int num_classes = count;
+ UNPROTECT (2); /* classes_s, call */
+
+ // basic classification
+ for (unsigned int i = 0; i < num_classes; ++i) {
+ if (classes[i] == "data.frame") type |= RObject::DataFrame;
+ }
+
+ if (Rf_isMatrix (value)) type |= RObject::Matrix;
+ if (Rf_isArray (value)) type |= RObject::Array;
+ if (Rf_isList (value)) type |= RObject::List;
+ if (Rf_isNewList (value)) type |= RObject::List;
+
+ if (type != 0) {
+ is_container = true;
+ } else {
+ if (Rf_isFunction (value)) {
+ is_function = true;
+ type |= RObject::Function;
+ } else if (Rf_isEnvironment (value)) {
+ is_container = true;
+ type |= RObject::Environment;
+ } else {
+ type |= RObject::Variable;
+ if (Rf_isFactor (value)) type |= RObject::Factor;
+ else if (Rf_isNumeric (value)) type |= RObject::Numeric;
+ else if (Rf_isString (value)) type |= RObject::Character;
+ else if (Rf_isLogical (value)) type |= RObject::Logical;
+ }
+ }
+ if (!Rf_isNull (Rf_getAttrib (value, meta_attrib))) type |= RObject::HasMetaObject;
+ if (misplaced) type |= RObject::Misplaced;
+
+ // TODO: store type
+
+ // TODO: store classes
+
+ // TODO: get and store dims
+
+ if (is_container) {
+ // TODO: get and store children
+ } else if (is_function) {
+ // TODO: get and store arguments
+ }
+}
+
Added: trunk/rkward/rkward/rbackend/rkstructuregetter.h
===================================================================
--- trunk/rkward/rkward/rbackend/rkstructuregetter.h (rev 0)
+++ trunk/rkward/rkward/rbackend/rkstructuregetter.h 2007-04-11 19:32:43 UTC (rev 1810)
@@ -0,0 +1,45 @@
+/***************************************************************************
+ rkstructuregetter - description
+ -------------------
+ begin : Wed Apr 11 2007
+ copyright : (C) 2007 by Thomas Friedrichsmeier
+ email : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ * *
+ * This program is free software; you can redistribute it and/or modify *
+ * it under the terms of the GNU General Public License as published by *
+ * the Free Software Foundation; either version 2 of the License, or *
+ * (at your option) any later version. *
+ * *
+ ***************************************************************************/
+
+#ifndef RKSTRUCTUREGETTER_H
+#define RKSTRUCTUREGETTER_H
+
+/** Low level helper class for getting the structure of R objects (.rk.get.structure).
+Since this is only used from REmbedInternal, and making Qt and R includes cooperate is so much trouble,
+this is designed to be included directly in rembedinternal.cpp, i.e. includes are not properly defined. I'll fix that later. */
+class RKStructureGetter {
+public:
+ RKStructureGetter (bool keep_evalled_promises);
+ ~RKStructureGetter ();
+
+ RData *getStructure (SEXP toplevel, SEXP name, SEXP namespacename);
+private:
+ void getStructureWorker (SEXP value, const QString &name, bool misplaced, RData *storage);
+
+ bool with_namespace;
+ SEXP namespace_envir;
+
+ SEXP class_fun;
+ SEXP meta_attrib;
+
+ bool keep_evalled_promises;
+
+ /** current depth of recursion into environments */
+ int envir_depth;
+};
+
+#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