Changeset: 86acf33216e8 for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=86acf33216e8
Modified Files:
monetdb5/modules/mal/Tests/rapi00.mal
monetdb5/modules/mal/rapi.c
monetdb5/modules/mal/rapi.h
Branch: RIntegration
Log Message:
Changed environment and user code handling
diffs (truncated from 388 to 300 lines):
diff --git a/monetdb5/modules/mal/Tests/rapi00.mal
b/monetdb5/modules/mal/Tests/rapi00.mal
--- a/monetdb5/modules/mal/Tests/rapi00.mal
+++ b/monetdb5/modules/mal/Tests/rapi00.mal
@@ -1,4 +1,4 @@
-# Hannes Muhleissen example
+# Hannes Muehleisen example
b:= bat.new(:oid,:int);
bat.append(b,1804289383);
bat.append(b,846930886);
@@ -13,6 +13,6 @@ bat.append(b,1189641421);
io.print(b);
-r:bat[:oid,:dbl] := rapi.eval("ret0 <- Re(fft(arg2));",b);
+r:bat[:oid,:dbl] := rapi.eval("someval <- Re(fft(arg1)); print(someval);
return(someval);",b);
io.print(r);
diff --git a/monetdb5/modules/mal/rapi.c b/monetdb5/modules/mal/rapi.c
--- a/monetdb5/modules/mal/rapi.c
+++ b/monetdb5/modules/mal/rapi.c
@@ -18,7 +18,7 @@
*/
/*
- * H. Muhleissen, M. Kersten
+ * H. Muehleisen, M. Kersten
* The R interface
*/
#include "monetdb_config.h"
@@ -29,40 +29,38 @@ static MT_Lock rapiLock;
char* R_HomeDir(void) {
// FIXME this won't work in general
- return "/usr/lib64/R";
+ return "/usr/lib64/R";
}
void writeConsole(const char * buf, int buflen) {
(void) buflen;
- THRprintf(GDKout, "%s",buf);
+ THRprintf(GDKout, "%s", buf);
}
void writeConsoleEx(const char * buf, int buflen, int foo) {
(void) buflen;
(void) foo;
- THRprintf(GDKout, "%s",buf);
+ THRprintf(GDKout, "%s", buf);
}
-str
-RAPIprelude(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci){
- char *rargv[] = { "whatever", "--quiet", "--no-save", "--vanilla" };
+str RAPIprelude(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci) {
+ char *rargv[] = { "whatever", "--quiet", "--no-save", "--vanilla" };
(void) cntxt;
(void) mb;
(void) stk;
(void) pci;
- MT_lock_init( &rapiLock,"rapi_lock");
- Rf_initEmbeddedR(4, rargv);
+ MT_lock_init(&rapiLock, "rapi_lock");
+ Rf_initEmbeddedR(4, rargv);
// these globals are indicative for non-thread safe R settings.
- ptr_R_WriteConsole = writeConsole;
- ptr_R_WriteConsoleEx = writeConsoleEx;
- R_Outputfile = NULL;
- R_Consolefile = NULL;
+ ptr_R_WriteConsole = writeConsole;
+ ptr_R_WriteConsoleEx = writeConsoleEx;
+ R_Outputfile = NULL;
+ R_Consolefile = NULL;
return MAL_SUCCEED;
}
-str
-RAPIpostlude(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci){
+str RAPIpostlude(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci) {
(void) cntxt;
(void) mb;
(void) stk;
@@ -71,164 +69,211 @@ RAPIpostlude(Client cntxt, MalBlkPtr mb,
return MAL_SUCCEED;
}
-str
-RAPIeval(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci){
- str exprStr = *(str*) getArgReference(stk,pci,pci->retc);
- SEXP x;
- ParseStatus status;
+str RAPIeval(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci) {
+ str exprStr = *(str*) getArgReference(stk, pci, pci->retc);
+ SEXP x, env,retval;
+ ParseStatus status;
int i;
- char buf[64]={"rapi"};
+ char buf[64] = "rapi";
+ char argnames[1000] = "";
+ char* rcall;
str *args;
- char *msg = createException(MAL,"rapi.eval","NYI");
+ int evalErr;
+ char *msg = createException(MAL, "rapi.eval", "NYI");
BAT *b;
- char *rargv[] = { "whatever", "--quiet", "--no-save", "--vanilla" };
- Rf_initEmbeddedR(4, rargv);
-
+ char *rargv[] = { "whatever", "--quiet", "--no-save", "--vanilla" };
+ Rf_initEmbeddedR(4, rargv);
(void) mb;
+ rcall = malloc(strlen(exprStr) + sizeof(argnames) + 100);
+ if (rcall==NULL) {
+ throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
+ }
+
args = (str*) GDKzalloc(sizeof(str) * pci->argc);
- if ( args == NULL)
- throw(MAL,"rapi.eval", MAL_MALLOC_FAIL);
-
- MT_lock_set(&rapiLock,"rapi.evaluate");
+ if (args == NULL)
+ throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
+
+ MT_lock_set(&rapiLock, "rapi.evaluate");
// check R expression for errors
#ifdef _RAPI_DEBUG_
- mnstr_printf(cntxt->fdout,"#Running R expression %s\n",exprStr);
+ mnstr_printf(cntxt->fdout, "#Running R expression %s\n", exprStr);
#else
(void) cntxt;
#endif
+ /* create new, empty environment */
+ /* ugly call required since Rf_NewEnvironment is not in the public
headers*/
+ env = eval(lang1(install("new.env")),R_GlobalEnv);
+
// install the MAL variables into the R environment
- for( i = pci->retc+1; i< pci->argc; i++){
- SEXP varname;
- SEXP varvalue;
+ for (i = pci->retc + 1; i < pci->argc; i++) {
+ SEXP varname = R_NilValue;
+ SEXP varvalue = R_NilValue;
- sprintf(buf,"arg%d", i);
+ sprintf(buf, "arg%d", i - 1);
args[i] = GDKstrdup(buf);
- varname = Rf_install( args[i]);
+ varname = Rf_install(args[i]);
// check for BAT or scalar first !!
- if ( isaBatType(getArgType(mb,pci,i))){
+ if (isaBatType(getArgType(mb,pci,i))) {
// hand over a BAT into a vector
- b = BATdescriptor(*(int*) getArgReference(stk,pci,i));
- if ( b== NULL)
- throw(MAL,"rapi.eval", MAL_MALLOC_FAIL);
+ b = BATdescriptor(*(int*) getArgReference(stk, pci, i));
+ if (b == NULL)
+ throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
// seems expensive to copy all values
- switch(ATOMstorage(getTailType(getArgType(mb,pci,i)))){
+ switch (ATOMstorage(getTailType(getArgType(mb,pci,i))))
{
case TYPE_bte:
varvalue = NEW_LOGICAL(BATcount(b));
- memcpy((char*)(LOGICAL_POINTER(varvalue)),
(char*) Tloc(b,BUNfirst(b)), BATcount(b) * sizeof(bte));
+ memcpy((char*) (LOGICAL_POINTER(varvalue)),
+ (char*) Tloc(b, BUNfirst(b)),
+ BATcount(b) * sizeof(bte));
break;
case TYPE_int:
varvalue = NEW_INTEGER(BATcount(b));
- memcpy((char*)(INTEGER_POINTER(varvalue)),
(char*) Tloc(b,BUNfirst(b)), BATcount(b) * sizeof(int));
+ memcpy((char*) (INTEGER_POINTER(varvalue)),
+ (char*) Tloc(b, BUNfirst(b)),
+ BATcount(b) * sizeof(int));
break;
case TYPE_dbl:
varvalue = NEW_NUMERIC(BATcount(b));
- memcpy((char*)(NUMERIC_POINTER(varvalue)),
(char*) Tloc(b,BUNfirst(b)), BATcount(b) * sizeof(dbl));
+ memcpy((char*) (NUMERIC_POINTER(varvalue)),
+ (char*) Tloc(b, BUNfirst(b)),
+ BATcount(b) * sizeof(dbl));
break;
case TYPE_str:
//varvalue = NEW_CHARACTER( strlen(*(str*)
getArgReference(stk,pci,i)));
break;
default:
// no clue what type to consider
- msg = createException(MAL,"rapi.eval","unknown
argument type");
+ msg = createException(MAL, "rapi.eval",
+ "unknown argument type");
goto wrapup;
}
BBPreleaseref(b->batCacheid);
- } else
- switch(ATOMstorage(getTailType(getArgType(mb,pci,i)))){
- case TYPE_bte:
- varvalue = NEW_LOGICAL(1);
- LOGICAL_POINTER(varvalue)[0] = *(int*)
getArgReference(stk,pci,i);
- break;
- case TYPE_int:
- varvalue = NEW_INTEGER(1);
- INTEGER_POINTER(varvalue)[0] = *(int*)
getArgReference(stk,pci,i);
- break;
- case TYPE_dbl:
- varvalue = NEW_NUMERIC(1);
- NUMERIC_POINTER(varvalue)[0]= *(flt*)
getArgReference(stk,pci,i);
- break;
- case TYPE_str:
- //varvalue = NEW_CHARACTER( strlen(*(str*)
getArgReference(stk,pci,i)));
- break;
- default:
- // no clue what type to consider
- msg = createException(MAL,"rapi.eval","unknown argument
type");
- goto wrapup;
- }
+ } else
+ switch (ATOMstorage(getTailType(getArgType(mb,pci,i))))
{
+ case TYPE_bte:
+ varvalue = NEW_LOGICAL(1);
+ LOGICAL_POINTER(varvalue)[0] = *(int*)
getArgReference(stk, pci,
+ i);
+ break;
+ case TYPE_int:
+ varvalue = NEW_INTEGER(1);
+ INTEGER_POINTER(varvalue)[0] = *(int*)
getArgReference(stk, pci,
+ i);
+ break;
+ case TYPE_dbl:
+ varvalue = NEW_NUMERIC(1);
+ NUMERIC_POINTER(varvalue)[0] = *(flt*)
getArgReference(stk, pci,
+ i);
+ break;
+ case TYPE_str:
+ //varvalue = NEW_CHARACTER( strlen(*(str*)
getArgReference(stk,pci,i)));
+ break;
+ default:
+ // no clue what type to consider
+ msg = createException(MAL, "rapi.eval",
+ "unknown argument type");
+ goto wrapup;
+ }
// TODO: it's probably a good idea to have a different, new
environment here
// TODO: also, let's use an anonymous function call to run the
user code
// install vector into R environment
- Rf_defineVar(varname,varvalue, R_GlobalEnv);
+ Rf_defineVar(varname, varvalue, env);
}
-
- x = R_ParseVector(mkString(exprStr), INT_MAX, &status, R_NilValue);
- if (status != PARSE_OK){
- msg= createException(MAL,"rapi.eval","%s", exprStr);
+
+ /* we are going to evaluate the user function within a anonymous
function call:
+ * ret <- (function(arg1){return(arg1*2)})(42)
+ * the user code is put inside the {}, this keeps our environment clean
(TM) and gives
+ * a clear path for return values, namely using the builtin return()
function
+ * this is also compatible with PL/R
+ */
+ for (i = pci->retc + 1; i < pci->argc; i++) {
+ sprintf(buf, "arg%d", i - 1);
+ strcat(argnames,buf);
+ if (i < pci->argc-1) {
+ strcat(argnames,",");
+ }
+ }
+ sprintf(rcall,"ret <-
function(%s){%s}(%s)\n",argnames,exprStr,argnames);
+
+ x = R_ParseVector(mkString(rcall), INT_MAX, &status, R_NilValue);
+ if (status != PARSE_OK) {
+ msg = createException(MAL, "rapi.eval", "%s", exprStr);
goto wrapup;
}
- // why this?
- for (i = 0; i < LENGTH(x); i++) {
- eval(VECTOR_ELT(x, i), R_GlobalEnv);
- }
+ /* parsing creates a separate call for each statement, since our r code
can consist of multiple statements, we need to evaluate each vector entry */
+ if (LENGTH(x) != 1) {
+ msg = createException(MAL, "rapi.eval", "%s", exprStr);
+ goto wrapup;
+ }
+ retval = R_tryEval(VECTOR_ELT(x, i), env,&evalErr);
+ if (evalErr != FALSE) {
+ msg = createException(MAL, "rapi.eval", "%s", exprStr);
+ goto wrapup;
+ }
+
+ // ret should be a data frame with exactly as many columns as we need
from retc
// collect the return values
- for( i=0; i< pci->retc; i++){
- SEXP othervar;
- sprintf(buf, "ret%d",i);
+ for (i = 0; i < pci->retc; i++) {
_______________________________________________
checkin-list mailing list
[email protected]
https://www.monetdb.org/mailman/listinfo/checkin-list
