[rkward-cvs] SF.net SVN: rkward:[3130] branches/2010_10_18_backend_restructuring_branch/ rkward/rbackend
tfry at users.sourceforge.net
tfry at users.sourceforge.net
Mon Oct 18 11:57:12 UTC 2010
Revision: 3130
http://rkward.svn.sourceforge.net/rkward/?rev=3130&view=rev
Author: tfry
Date: 2010-10-18 11:57:12 +0000 (Mon, 18 Oct 2010)
Log Message:
-----------
Start adding alternatives for the no-longer-existent direct command runners. Don't let R define all those aliases for Rf_XXX. They start getting in the way.
Modified Paths:
--------------
branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h
branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp
Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp 2010-10-18 11:13:59 UTC (rev 3129)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.cpp 2010-10-18 11:57:12 UTC (rev 3130)
@@ -46,6 +46,9 @@
#endif
#include <math.h>
+// keep R from defining tons of aliases
+#define R_NO_REMAP 1
+
#include <Rversion.h>
#if (R_VERSION > R_Version(2, 6, 9))
@@ -563,14 +566,14 @@
// bad format? coerce the vector first
if (TYPEOF (from_exp) != STRSXP) {
SEXP strexp;
- PROTECT (strexp = coerceVector (from_exp, STRSXP));
+ PROTECT (strexp = Rf_coerceVector (from_exp, STRSXP));
QString *list = SEXPToStringList (strexp, count);
UNPROTECT (1);
return list;
}
// format already good? Avoid coercion (and associated copying)
- *count = length (from_exp);
+ *count = Rf_length (from_exp);
QString *list = new QString[*count];
unsigned int i = 0;
for (; i < *count; ++i) {
@@ -608,14 +611,14 @@
// bad format? coerce the vector first
if (TYPEOF (from_exp) != INTSXP) {
SEXP intexp;
- PROTECT (intexp = coerceVector (from_exp, INTSXP));
+ PROTECT (intexp = Rf_coerceVector (from_exp, INTSXP));
integers = SEXPToIntArray (intexp, count);
UNPROTECT (1);
return integers;
}
// format already good? Avoid coercion (and associated copying)
- *count = length (from_exp);
+ *count = Rf_length (from_exp);
integers = new int[*count];
for (unsigned int i = 0; i < *count; ++i) {
integers[i] = INTEGER (from_exp)[i];
@@ -645,14 +648,14 @@
// bad format? coerce the vector first
if (TYPEOF (from_exp) != REALSXP) {
SEXP realexp;
- PROTECT (realexp = coerceVector (from_exp, REALSXP));
+ PROTECT (realexp = Rf_coerceVector (from_exp, REALSXP));
reals = SEXPToRealArray (realexp, count);
UNPROTECT (1);
return reals;
}
// format already good? Avoid coercion (and associated copying)
- *count = length (from_exp);
+ *count = Rf_length (from_exp);
reals = new double[*count];
for (unsigned int i = 0; i < *count; ++i) {
reals[i] = REAL (from_exp)[i];
@@ -680,7 +683,7 @@
break;
case VECSXP:
count = 0;
- count = length (from_exp);
+ count = Rf_length (from_exp);
{
RData **structure_array = new RData*[count];
for (unsigned int i=0; i < count; ++i) {
@@ -768,12 +771,12 @@
RK_TRACE (RBACKEND);
RK_ASSERT (REmbedInternal::this_pointer->current_locale_codec);
- SEXP res = allocVector(STRSXP, 1);
+ SEXP res = Rf_allocVector(STRSXP, 1);
PROTECT (res);
#ifdef R_2_9
- SET_STRING_ELT (res, 0, mkChar (REmbedInternal::this_pointer->current_locale_codec->name ().data ()));
+ SET_STRING_ELT (res, 0, Rf_mkChar (REmbedInternal::this_pointer->current_locale_codec->name ().data ()));
#else
- SET_VECTOR_ELT (res, 0, mkChar (REmbedInternal::this_pointer->current_locale_codec->name ().data ()));
+ SET_VECTOR_ELT (res, 0, Rf_mkChar (REmbedInternal::this_pointer->current_locale_codec->name ().data ()));
#endif
UNPROTECT (1);
return res;
@@ -792,17 +795,17 @@
SEXP doGetGlobalEnvStructure (SEXP name, SEXP envlevel, SEXP namespacename) {
RK_TRACE (RBACKEND);
- return doGetStructure (findVar (Rf_install (CHAR (STRING_ELT (name, 0))), R_GlobalEnv), name, envlevel, namespacename);
+ return doGetStructure (Rf_findVar (Rf_install (CHAR (STRING_ELT (name, 0))), R_GlobalEnv), name, envlevel, namespacename);
}
/** copy a symbol without touching it (esp. not forcing any promises) */
SEXP doCopyNoEval (SEXP name, SEXP fromenv, SEXP toenv) {
RK_TRACE (RBACKEND);
- if(!isString (name) || length (name) != 1) error ("name is not a single string");
- if(!isEnvironment (fromenv)) error ("fromenv is not an environment");
- if(!isEnvironment (toenv)) error ("toenv is not an environment");
- defineVar (Rf_install (CHAR (STRING_ELT (name, 0))), findVar (Rf_install (CHAR (STRING_ELT (name, 0))), fromenv), toenv);
+ if(!Rf_isString (name) || Rf_length (name) != 1) Rf_error ("name is not a single string");
+ if(!Rf_isEnvironment (fromenv)) Rf_error ("fromenv is not an environment");
+ if(!Rf_isEnvironment (toenv)) Rf_error ("toenv is not an environment");
+ Rf_defineVar (Rf_install (CHAR (STRING_ELT (name, 0))), Rf_findVar (Rf_install (CHAR (STRING_ELT (name, 0))), fromenv), toenv);
return (R_NilValue);
}
@@ -887,13 +890,13 @@
connectCallbacks();
// get info on R runtime version
- REmbedInternal::RKWardRError error;
- unsigned int count;
- int *dummy = getCommandAsIntVector ("as.numeric (R.version$major) * 1000 + as.numeric (R.version$minor) * 10", &count, &error);
- RK_ASSERT ((error == REmbedInternal::NoError) && (count == 1));
- if (count) r_version = dummy[0];
- else r_version = 0;
- delete [] dummy;
+ RCommand *dummy = runDirectCommand ("as.numeric (R.version$major) * 1000 + as.numeric (R.version$minor) * 10", RCommand::GetIntVector);
+ if ((dummy->getDataType () == RData::IntVector) && (dummy->getDataLength () == 1)) {
+ r_version = dummy->getIntVector ()[0];
+ } else {
+ RK_ASSERT (false);
+ r_version = 0;
+ }
return true;
}
@@ -907,11 +910,11 @@
QByteArray localc = REmbedInternal::this_pointer->current_locale_codec->fromUnicode (command_qstring); // needed so the string below does not go out of scope
const char *command = localc.data ();
- PROTECT(cv=allocVector(STRSXP, 1));
+ PROTECT(cv=Rf_allocVector(STRSXP, 1));
#ifdef R_2_9
- SET_STRING_ELT(cv, 0, mkChar(command));
+ SET_STRING_ELT(cv, 0, Rf_mkChar(command));
#else
- SET_VECTOR_ELT(cv, 0, mkChar(command));
+ SET_VECTOR_ELT(cv, 0, Rf_mkChar(command));
#endif
// TODO: Maybe we can use R_ParseGeneral instead. Then we could find the exact character, where parsing fails. Nope: not exported API
@@ -1038,20 +1041,25 @@
}
}
-void REmbedInternal::runCommandInternal (const QString &command_qstring, RKWardRError *error, bool print_result) {
+bool REmbedInternal::runDirectCommand (const QString &command) {
RK_TRACE (RBACKEND);
- // Apparently the line below is no good idea after all. At least on Windows, this causes issues (crashes) with RGtk2, and several methods-using libraries
- //connectCallbacks (); // sorry, but we will not play nicely with additional frontends trying to override our callbacks. (Unless they start their own R event loop, then they should be fine)
+ RCommand c (command, RCommand::App | RCommand::Sync);
+ runCommand (&c);
+ return (c.succeeded ());
+}
- *error = NoError;
- if (!print_result) {
- SEXP parsed = parseCommand (command_qstring, error);
- if (*error == NoError) runCommandInternalBase (parsed, error);
- } else {
+RCommand *REmbedInternal::runDirectCommand (const QString &command, RCommand::CommandTypes datatype) {
+ RK_TRACE (RBACKEND);
+ RK_ASSERT ((datatype >= RCommand::GetIntVector) && (datatype <= RCommand::GetStructuredData));
+
+ RCommand *c = new RCommand (command, RCommand::App | RCommand::Sync | datatype);
+ runCommand (c);
+ return c;
}
void REmbedInternal::runCommand (RCommand *command) {
+ RK_TRACE (RBACKEND);
RK_ASSERT (command);
RKWardRError error = NoError;
@@ -1099,20 +1107,20 @@
}
if (ok == FALSE) {
if (repldll_last_parse_successful) {
- *error = REmbedInternal::OtherError;
+ error = REmbedInternal::OtherError;
} else {
- *error = REmbedInternal::SyntaxError;
+ error = REmbedInternal::SyntaxError;
}
} else {
if (prev_iteration_was_incomplete) {
- *error = REmbedInternal::Incomplete;
+ error = REmbedInternal::Incomplete;
} else {
- *error = REmbedInternal::NoError;
+ error = REmbedInternal::NoError;
}
}
repldlldo1_wants_code = false; // make sure we don't get confused in RReadConsole
} else { // not a user command
- SEXP parsed = parseCommand (command, &error);
+ SEXP parsed = parseCommand (command->command (), &error);
if (error == NoError) {
SEXP exp;
PROTECT (exp = runCommandInternalBase (parsed, &error));
@@ -1127,7 +1135,7 @@
command->datatype = RData::StringVector;
command->data = SEXPToIntArray (exp, &(command->length));
} else if (command->type () & RCommand::GetStructuredData) {
- RData *data SEXPToRData (exp);
+ RData *data = SEXPToRData (exp);
if (data) command->setData (data);
}
}
@@ -1158,11 +1166,9 @@
RK_DO (qDebug ("Command failed (other)"), RBACKEND, dl);
}
RK_DO (qDebug ("failed command was: '%s'", command->command ().toLatin1 ().data ()), RBACKEND, dl);
+ flushOutput ();
+ RK_DO (qDebug ("- error message was: '%s'", command->error ().toLatin1 ().data ()), RBACKEND, dl);
} else {
command->status |= RCommand::WasTried;
}
-
- if (error) {
- RK_DO (qDebug ("- error message was: '%s'", command->error ().toLatin1 ().data ()), RBACKEND, dl);
- }
}
Modified: branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h
===================================================================
--- branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h 2010-10-18 11:13:59 UTC (rev 3129)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rembedinternal.h 2010-10-18 11:57:12 UTC (rev 3130)
@@ -23,6 +23,8 @@
#include <QMap>
#include <QVariant>
+#include "rcommand.h"
+
#ifdef Q_WS_WIN
extern "C" {
void RK_scheduleIntr();
@@ -50,8 +52,6 @@
};
class QStringList;
-class RData;
-class RCommand;
class QTextCodec;
/** This function converts a list of strings to a QStringList (locale aware), and returns the pointer. Needed to keep R and Qt includes separate. The strings can be deleted afterwards. Implementation is in rthread.cpp */
QString *stringsToStringList (char **strings, int count);
@@ -94,13 +94,16 @@
@param argv Arguments as would be passed on the commandline to R
@param stack_check C stack checking enabled */
bool startR (int argc, char **argv, bool stack_check);
-/** low-level running of a command.
- at param command command to be run
- at param error this will be set to a value in RKWardError depending on success/failure of the command
- at param print_result whether the R_Visible flag should be set. If true, R will behave mostly as if in a regular console session. Otherwise values
-will only be printed if called for expressedly with print ("...") or similar.
- at param suppress_incomplete make sure never to run an incomplete command */
- void runCommandInternal (const QString &command, RKWardRError *error, bool print_result=false);
+
+/** convenience low-level function for running a command, directly
+ at param command command to be runCommand
+ at returns true if command was run successfully, false in case of an error */
+ bool runDirectCommand (const QString &command);
+/** convenience low-level function for running a command, directly. Use this overload, if you want to handle a return value.
+ at param command command to be runCommand
+ at param datatype the data type that should be (attempted to be) returned
+ at returns a pointer to the RCommand-instance that was created and used, internally. You can query this pointer for status and data. Be sure to delete it, when done. */
+ RCommand *runDirectCommand (const QString &command, RCommand::CommandTypes datatype);
public:
/** call this periodically to make R's x11 windows process their events */
static void processX11Events ();
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-18 11:13:59 UTC (rev 3129)
+++ branches/2010_10_18_backend_restructuring_branch/rkward/rbackend/rkstructuregetter.cpp 2010-10-18 11:57:12 UTC (rev 3130)
@@ -71,25 +71,25 @@
}
SEXP RKStructureGetter::callSimpleFun (SEXP fun, SEXP arg, SEXP env) {
- SEXP call = allocVector (LANGSXP, 2);
+ SEXP call = Rf_allocVector (LANGSXP, 2);
PROTECT (call);
SETCAR (call, fun);
SETCAR (CDR (call), arg);
- SEXP ret = eval (call, env);
+ SEXP ret = Rf_eval (call, env);
UNPROTECT (1); /* call */
return ret;
}
SEXP RKStructureGetter::callSimpleFun2 (SEXP fun, SEXP arg1, SEXP arg2, SEXP env) {
- SEXP call = allocVector (LANGSXP, 3);
+ SEXP call = Rf_allocVector (LANGSXP, 3);
PROTECT (call);
SETCAR (call, fun);
SETCAR (CDR (call), arg1);
SETCAR (CDDR (call), arg2);
- SEXP ret = eval (call, env);
+ SEXP ret = Rf_eval (call, env);
UNPROTECT (1); /* call */
return ret;
@@ -175,7 +175,7 @@
PROTECT (from);
SET_PRSEEN(from, 1);
- ret = eval(PRCODE(from), PRENV(from));
+ ret = Rf_eval(PRCODE(from), PRENV(from));
SET_PRSEEN(from, 0);
if (keep_evalled_promises) {
SET_PRVALUE(from, ret);
@@ -224,7 +224,7 @@
extern SEXP R_data_class (SEXP, Rboolean);
classes_s = R_data_class (value, (Rboolean) 0);
- value = coerceVector (value, EXPRSXP); // make sure the object is safe for everything to come
+ value = Rf_coerceVector (value, EXPRSXP); // make sure the object is safe for everything to come
UNPROTECT (1); /* old value */
PROTECT (classes_s);
@@ -389,7 +389,7 @@
if (do_env) {
RK_DO (qDebug ("recurse into environment %s", name.toLatin1().data ()), RBACKEND, DL_DEBUG);
for (unsigned int i = 0; i < childcount; ++i) {
- SEXP current_childname = install(CHAR(STRING_ELT(childnames_s, i)));
+ SEXP current_childname = Rf_install(CHAR(STRING_ELT(childnames_s, i)));
PROTECT (current_childname);
SEXP child = Rf_findVar (current_childname, value);
PROTECT (child);
@@ -466,7 +466,7 @@
funargvaluesdata->data = SEXPToStringList (formals_s, &(funargvaluesdata->length));
// the argument names
- SEXP names_s = getAttrib (formals_s, R_NamesSymbol);
+ SEXP names_s = Rf_getAttrib (formals_s, R_NamesSymbol);
PROTECT (names_s);
funargsdata->data = SEXPToStringList (names_s, &(funargsdata->length));
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