[rkward-cvs] SF.net SVN: rkward: [1791] trunk/rkward

[tfry at users.sourceforge.net]

Revision: 1791
          http://svn.sourceforge.net/rkward/?rev=1791&view=rev
Author:   tfry
Date:     2007-04-05 09:28:37 -0700 (Thu, 05 Apr 2007)

Log Message:
-----------
Thoughts on optimizing .rk.get.structure()

Modified Paths:
--------------
    trunk/rkward/TODO
    trunk/rkward/rkward/rbackend/rembedinternal.cpp
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R

Modified: trunk/rkward/TODO
===================================================================
--- trunk/rkward/TODO	2007-04-05 15:38:13 UTC (rev 1790)
+++ trunk/rkward/TODO	2007-04-05 16:28:37 UTC (rev 1791)
@@ -117,6 +117,15 @@
 		- see http://sourceforge.net/mailarchive/forum.php?thread_name=200703230304.43023.kapatp%40gmail.com&forum_name=rkward-devel
 
 Internal stuff:
+	- implement .rk.get.structure() in C
+		- Probably create an EXTPTRSXP to hold an RData object directly
+		- The real structure fetching is done in a separate tryEval() or R_ToplevelExec() (but check, since when this is available!), to guard against errors, and clean up the RData, if needed
+		- When encountering a promise, the following behaviors might be user configurable:
+			1: Don't fetch the structure for this object
+			2: Load the object and fetch the structure, but *do not* keep the data (see eval.c for what not to do with a PROMSXP, and how to still get the value)
+			3: Load the object in the usual way and fetch the structure
+		- Preinstall all used function calls - if possible - for maximum speed
+		- What kind of character encoding conversion will we need to do, and where? Probably we can simply use SEXPToStringList, though
 	- Handling fonts:
 		- http://sourceforge.net/mailarchive/forum.php?thread_id=31631211&forum_id=12970
 	- Look at package odfWeave, and find out, how to use this

Modified: trunk/rkward/rkward/rbackend/rembedinternal.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.cpp	2007-04-05 15:38:13 UTC (rev 1790)
+++ trunk/rkward/rkward/rbackend/rembedinternal.cpp	2007-04-05 16:28:37 UTC (rev 1791)
@@ -429,7 +429,6 @@
 	}
 }
 
-/** This function is the R side wrapper around stringsToStringList */
 QString *SEXPToStringList (SEXP from_exp, unsigned int *count) {
 	RK_TRACE (RBACKEND);
 
@@ -627,6 +626,19 @@
 	return R_NilValue;
 }
 
+/* Testing code. TODO: clean up
+SEXP doTestType (SEXP name, SEXP envir) {
+	RK_TRACE (RBACKEND);
+
+	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;
+} */
+
 bool REmbedInternal::registerFunctions (const char *library_path) {
 	RK_TRACE (RBACKEND);
 
@@ -638,6 +650,7 @@
 		{ "rk.do.error", (DL_FUNC) &doError, 1 },
 		{ "rk.do.command", (DL_FUNC) &doSubstackCall, 1 },
 		{ "rk.update.locale", (DL_FUNC) &doUpdateLocale, 0 },
+//		{ "rk.test.type", (DL_FUNC) &doTestType, 2 }, // Testing code. TODO: clean up
 		{ 0, 0, 0 }
 	};
 	R_registerRoutines (info, NULL, callMethods, NULL, NULL);

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2007-04-05 15:38:13 UTC (rev 1790)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R	2007-04-05 16:28:37 UTC (rev 1791)
@@ -256,12 +256,16 @@
 	eval (substitute (x <- y), envir=envir)
 }
 
-".rk.get.structure" <- function (x, name, envlevel=0, namespacename=NULL, misplaced=FALSE) {
+".rk.get.structure" <- function (x, name, envlevel=0, namespacename=NULL, misplaced=FALSE, envir) {
 	fun <- FALSE
 	cont <- FALSE
 	type <- 0
 
 # Do not change the order! Make sure all fields exist, even if empty
+	if (missing (x)) {
+#		.Call ("rk.test.type", name, envir) # Testing code. TODO: clean up
+		x <- get (name, envir=envir)
+	}
 
 # 1: name should always be first
 	name <- as.character (name)
@@ -341,7 +345,7 @@
 		lst <- ls (x, all.names=TRUE)
 		if (is.null (namespacename)) {
 			for (childname in lst) {
-				ret[[childname]] <- .rk.get.structure (get (childname, envir=x), childname, envlevel)
+				ret[[childname]] <- .rk.get.structure (name=childname, envlevel=envlevel, envir=x)
 			}
 		} else {
 			# before R 2.4.0, operator "::" would only work on true namespaces, not on package names (operator "::" work, if there is a namespace, and that namespace has the symbol in it)
@@ -351,7 +355,7 @@
 				for (childname in lst) {
 					misplaced <- FALSE
 					if (is.null (ns) || (!exists (childname, envir=ns, inherits=FALSE))) misplaced <- TRUE
-					ret[[childname]] <- .rk.get.structure (get (childname, envir=x), childname, envlevel, misplaced=misplaced)
+					ret[[childname]] <- .rk.get.structure (name=childname, envlevel=envlevel, misplaced=misplaced, envir=x)
 				}
 			} else {
 			# for R 2.4.0 or greater: operator "::" works if package has no namespace at all, or has a namespace with the symbol in it
@@ -359,7 +363,7 @@
 				for (childname in lst) {
 					misplaced <- FALSE
 					if ((!is.null (ns)) && (!exists (childname, envir=ns, inherits=FALSE))) misplaced <- TRUE
-					ret[[childname]] <- .rk.get.structure (get (childname, envir=x), childname, envlevel, misplaced=misplaced)
+					ret[[childname]] <- .rk.get.structure (name=childname, envlevel=envlevel, misplaced=misplaced, envir=x)
 				}
 			}
 		}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.