[rkward-cvs] SF.net SVN: rkward:[3137] branches/2010_10_18_backend_restructuring_branch

[tfry at users.sourceforge.net]

Revision: 3137
          http://rkward.svn.sourceforge.net/rkward/?rev=3137&view=rev
Author:   tfry
Date:     2010-10-22 12:27:35 +0000 (Fri, 22 Oct 2010)

Log Message:
-----------
Support ReferenceClasses

Modified Paths:
--------------
    branches/2010_10_18_backend_restructuring_branch/ChangeLog
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp
    branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h

Modified: branches/2010_10_18_backend_restructuring_branch/ChangeLog
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/ChangeLog	2010-10-22 11:10:53 UTC (rev 3136)
+++ branches/2010_10_18_backend_restructuring_branch/ChangeLog	2010-10-22 12:27:35 UTC (rev 3137)
@@ -1,3 +1,4 @@
+- Fixed: Would fail to analyse structure of ReferenceClass-objects
 - Fixed: "Vector" mode in "Paste special" action did not work correctly
 - Attempt to save workspace on crashes		TODO: detect recovery-file at startup, and offer to load it.
 - Also try to relay SIGABRT and SIGILL to the proper signal handlers

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h	2010-10-22 11:10:53 UTC (rev 3136)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rinterface.h	2010-10-22 12:27:35 UTC (rev 3137)
@@ -24,7 +24,7 @@
 
 #include "rcommand.h"
 
-#define DEBUG_MUTEX
+//#define DEBUG_MUTEX
 #ifdef DEBUG_MUTEX
 #define MUTEX_LOCK RInterface::mutex.lock (); qDebug ("mutex locks: %d, locked in %s, %s, %d", ++RInterface::mutex_counter, __FILE__, __FUNCTION__, __LINE__); 
 #define MUTEX_UNLOCK qDebug ("mutex locks: %d, unlocked in %s, %s, %d", --RInterface::mutex_counter, __FILE__, __FUNCTION__, __LINE__); RInterface::mutex.unlock ();

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp	2010-10-22 11:10:53 UTC (rev 3136)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp	2010-10-22 12:27:35 UTC (rev 3137)
@@ -36,6 +36,7 @@
 	is_list_fun = prefetch_fun ("is.list");
 	is_function_fun = prefetch_fun ("is.function");
 	is_environment_fun = prefetch_fun ("is.environment");
+	as_environment_fun = prefetch_fun ("as.environment");
 	is_factor_fun = prefetch_fun ("is.factor");
 	is_numeric_fun = prefetch_fun ("is.numeric");
 	is_character_fun = prefetch_fun ("is.character");
@@ -203,11 +204,11 @@
 
 	RK_DO (qDebug ("fetching '%s': %p, s-type %d", name.toLatin1().data(), val, TYPEOF (val)), RBACKEND, DL_DEBUG);
 
-	PROTECT (val);
+	SEXP value = val;
+	PROTECT_INDEX value_index;
+	PROTECT_WITH_INDEX (value, &value_index);
 	// manually resolve any promises
-	SEXP value = resolvePromise (val);
-	UNPROTECT (1);		/* val */
-	PROTECT (value);
+	REPROTECT (value = resolvePromise (value), value_index);
 
 	// first field: get name
 	RData *namedata = new RData;
@@ -224,11 +225,9 @@
 		extern SEXP R_data_class (SEXP, Rboolean);
 		classes_s = R_data_class (value, (Rboolean) 0);
 
-		value = Rf_coerceVector (value, EXPRSXP);	// make sure the object is safe for everything to come
-		UNPROTECT (1); /* old value */
+		REPROTECT (value = Rf_coerceVector (value, EXPRSXP), value_index);	// make sure the object is safe for everything to come
 
 		PROTECT (classes_s);
-		PROTECT (value);
 	} else {
 		classes_s = callSimpleFun (class_fun, value, R_BaseEnv);
 		PROTECT (classes_s);
@@ -263,9 +262,8 @@
 			type |= RObject::Function;
 		} else if (callSimpleBool (is_environment_fun, value, R_BaseEnv)) {
 			is_container = true;
-#warning TODO: if is (x, "refClass"), we should treat it as a list, not environment
+			type |= RObject::Environment;
 			is_environment = true;
-			type |= RObject::Environment;
 		} else {
 			type |= RObject::Variable;
 			if (callSimpleBool (is_factor_fun, value, R_BaseEnv)) type |= RObject::Factor;
@@ -388,6 +386,11 @@
 
 		if (do_env) {
 			RK_DO (qDebug ("recurse into environment %s", name.toLatin1().data ()), RBACKEND, DL_DEBUG);
+			if (!Rf_isEnvironment (value)) {
+				// some classes (ReferenceClasses) are identified as envionments by is.environment(), but are not internally ENVSXPs.
+				// For these, Rf_findVar would fail.
+				REPROTECT (value = callSimpleFun (as_environment_fun, value, R_GlobalEnv), value_index);
+			}
 			for (unsigned int i = 0; i < childcount; ++i) {
 				SEXP current_childname = Rf_install(CHAR(STRING_ELT(childnames_s, i)));
 				PROTECT (current_childname);

Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h	2010-10-22 11:10:53 UTC (rev 3136)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.h	2010-10-22 12:27:35 UTC (rev 3137)
@@ -60,6 +60,7 @@
 	SEXP is_list_fun;
 	SEXP is_function_fun;
 	SEXP is_environment_fun;
+	SEXP as_environment_fun;
 	SEXP is_factor_fun;
 	SEXP is_numeric_fun;
 	SEXP is_character_fun;


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