[rkward-cvs] SF.net SVN: rkward: [1818] trunk/rkward/rkward/rbackend
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Mon Apr 16 21:27:16 UTC 2007
Revision: 1818
http://svn.sourceforge.net/rkward/?rev=1818&view=rev
Author: tfry
Date: 2007-04-16 14:27:16 -0700 (Mon, 16 Apr 2007)
Log Message:
-----------
The new .rk.get.structure works modulo some minor quirks, but is not yet activated.
Also lots of cleanups are still needed.
Modified Paths:
--------------
trunk/rkward/rkward/rbackend/rembedinternal.cpp
trunk/rkward/rkward/rbackend/rkstructuregetter.cpp
trunk/rkward/rkward/rbackend/rkstructuregetter.h
trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
Modified: trunk/rkward/rkward/rbackend/rembedinternal.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.cpp 2007-04-16 19:25:15 UTC (rev 1817)
+++ trunk/rkward/rkward/rbackend/rembedinternal.cpp 2007-04-16 21:27:16 UTC (rev 1818)
@@ -119,6 +119,8 @@
bool repldll_last_parse_successful = false;
#endif
+SEXP RKWard_RData_Tag;
+
// ############## R Standard callback overrides BEGIN ####################
void RSuicide (char* message) {
RK_TRACE (RBACKEND);
@@ -557,6 +559,15 @@
data->datatype = RData::NoData;
count = 0;
break; */
+ case EXTPTRSXP:
+ if (R_ExternalPtrTag (from_exp) == RKWard_RData_Tag) {
+ delete data;
+ data = (RData*) R_ExternalPtrAddr (from_exp);
+// R_SetExternalPtrAddr (from_exp, 0);
+qDebug ("data length %d", data->length);
+ count = data->length;
+ break;
+ }
case STRSXP:
default:
data->data = SEXPToStringList (from_exp, &count);
@@ -608,11 +619,13 @@
RKGlobals::na_double = NA_REAL;
R_Interactive = (Rboolean) TRUE;
R_ReplDLLinit ();
+ RKWard_RData_Tag = Rf_install ("RKWard_RData_Tag");
return true;
#else
bool ok = (Rf_initEmbeddedR (argc, argv) >= 0);
RKGlobals::na_double = NA_REAL;
R_ReplDLLinit ();
+ RKWard_RData_Tag = Rf_install ("RKWard_RData_Tag");
return ok;
#endif
}
@@ -634,8 +647,7 @@
RKStructureGetter getter (false);
RData *ret = getter.getStructure (toplevel, name, namespacename);
-
- return R_NilValue;
+ return R_MakeExternalPtr (ret, RKWard_RData_Tag, R_NilValue);
}
bool REmbedInternal::registerFunctions (const char *library_path) {
Modified: trunk/rkward/rkward/rbackend/rkstructuregetter.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rkstructuregetter.cpp 2007-04-16 19:25:15 UTC (rev 1817)
+++ trunk/rkward/rkward/rbackend/rkstructuregetter.cpp 2007-04-16 21:27:16 UTC (rev 1818)
@@ -75,15 +75,15 @@
PROTECT (names_fun);
RK_ASSERT (!Rf_isNull (names_fun));
- /* TODO:
- formals-handling
- */
+ make_argvalues_fun = Rf_findFun (Rf_install (".rk.make.argvalues"), R_GlobalEnv);
+ PROTECT (make_argvalues_fun);
+ RK_ASSERT (!Rf_isNull (make_argvalues_fun));
}
RKStructureGetter::~RKStructureGetter () {
RK_TRACE (RBACKEND);
- UNPROTECT (13); /* all the pre-resolved functions */
+ UNPROTECT (14); /* all the pre-resolved functions */
}
SEXP RKStructureGetter::callSimpleFun (SEXP fun, SEXP arg) {
@@ -107,6 +107,7 @@
RData *RKStructureGetter::getStructure (SEXP toplevel, SEXP name, SEXP namespacename) {
RK_TRACE (RBACKEND);
+ // TODO: accept an envlevel parameter
envir_depth = 0;
unsigned int count;
@@ -234,6 +235,7 @@
if (type != 0) {
is_container = true;
+ type |= RObject::Container;
} else {
if (callSimpleBool (is_function_fun, value)) {
is_function = true;
@@ -393,11 +395,15 @@
getStructureWorker (child, childnames[i], false, children[i]);
CDR (value);
}
- } else { // new style list
+ } else if (Rf_isNewList (value)) { // new style list
for (unsigned int i = 0; i < childcount; ++i) {
SEXP child = VECTOR_ELT(value, i);
getStructureWorker (child, childnames[i], false, children[i]);
}
+ } else {
+ // TODO: handle this case (an S4 object pretending to be a list; will need to use operator [[)
+ childdata->length = 0;
+qDebug ("TODO");
}
}
UNPROTECT (1); /* childnames_s */
@@ -419,33 +425,23 @@
if (TYPEOF (value) == CLOSXP) { // if it is not, it does not have any formals
SEXP formals_s = FORMALS (value);
PROTECT (formals_s);
-qDebug ("%d args", Rf_length (formals_s));
-qDebug ("fun1");
SEXP names_s = getAttrib (formals_s, R_NamesSymbol);
PROTECT (names_s);
-qDebug ("fun2");
+
+ // the argument names
funargsdata->data = SEXPToStringList (names_s, &(funargsdata->length));
-qDebug ("fun3");
- // TODO: get and store argument values
-
- // convert argument values to character representation
-/* unsigned int length = Rf_length (formals_s);
- SEXP argvalues_char_s = Rf_allocVector (STRSXP, Rf_length (formals_s));
- PROTECT (arg_values_char_s);
- for (unsigned int i = 0; i < length; ++i) {
- if (TYPEOF (VECTOR_ELT (formals_s, i)) == STRSXP) {
- SET_VECTOR_ELT (formals_s,
- }
- } */
+
+ // the default values
+ SEXP formals_string_s = callSimpleFun (make_argvalues_fun, formals_s);
+ PROTECT (formals_string_s);
QString *dummy1;
- funargvaluesdata->data = dummy1 = SEXPToStringList (formals_s, &(funargvaluesdata->length));
-qDebug ("fun4");
+ funargvaluesdata->data = dummy1 = SEXPToStringList (formals_string_s, &(funargvaluesdata->length));
QString dummy;
for (unsigned int i = 0; i < funargvaluesdata->length; ++i) {
dummy.append (dummy1[i] + "\t");
}
qDebug ("%s", dummy.latin1());
- UNPROTECT (2); /* names_s, formals_s */
+ UNPROTECT (3); /* formals_string_s, names_s, formals_s */
} else {
qDebug ("not a closure");
}
Modified: trunk/rkward/rkward/rbackend/rkstructuregetter.h
===================================================================
--- trunk/rkward/rkward/rbackend/rkstructuregetter.h 2007-04-16 19:25:15 UTC (rev 1817)
+++ trunk/rkward/rkward/rbackend/rkstructuregetter.h 2007-04-16 21:27:16 UTC (rev 1818)
@@ -50,6 +50,7 @@
SEXP is_character_fun;
SEXP is_logical_fun;
SEXP names_fun;
+ SEXP make_argvalues_fun;
bool keep_evalled_promises;
Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2007-04-16 19:25:15 UTC (rev 1817)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/internal.R 2007-04-16 21:27:16 UTC (rev 1818)
@@ -256,7 +256,7 @@
eval (substitute (x <- y), envir=envir)
}
-".rk.get.structure" <- function (x, name, envlevel=0, namespacename=NULL, misplaced=FALSE, envir) {
+".rk.get.structure.old" <- function (x, name, envlevel=0, namespacename=NULL, misplaced=FALSE, envir) {
fun <- FALSE
cont <- FALSE
type <- 0
@@ -338,6 +338,21 @@
return (invisible (list (name, type, classes, meta, dims)))
}
+".rk.get.structure.new" <- function (x, name, envlevel=0, namespacename=NULL) {
+ .Call ("rk.get.structure.test", x, name, namespacename)
+}
+
+".rk.get.structure" <- .rk.get.structure.old
+
+# use as .rk.make.argvalues (formals (fun))
+".rk.make.argvalues" <- function (x) {
+ as.character (lapply (x,
+ function (v) {
+ if (is.character (v)) return (encodeString (v, quote="\""))
+ else return (v)
+ } ))
+}
+
".rk.get.environment.children" <- function (x, envlevel=0, namespacename=NULL) {
ret <- list ()
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