Changeset: 7abb83c6f44d for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=7abb83c6f44d
Added Files:
monetdb5/extras/rapi/50_rapi.mal
sql/backends/monet5/Tests/r00.sql
sql/scripts/50_rapi.sql
Removed Files:
monetdb5/extras/rapi/00_rapi.mal
Modified Files:
monetdb5/extras/rapi/Makefile.ag
monetdb5/extras/rapi/rapi.c
monetdb5/extras/rapi/rapi.h
monetdb5/extras/rapi/rapi.mal
sql/backends/monet5/Makefile.ag
sql/backends/monet5/Tests/All
sql/scripts/Makefile.ag
Branch: RIntegration
Log Message:
Step towards SQL integration
diffs (truncated from 582 to 300 lines):
diff --git a/monetdb5/extras/rapi/00_rapi.mal b/monetdb5/extras/rapi/50_rapi.mal
rename from monetdb5/extras/rapi/00_rapi.mal
rename to monetdb5/extras/rapi/50_rapi.mal
diff --git a/monetdb5/extras/rapi/Makefile.ag b/monetdb5/extras/rapi/Makefile.ag
--- a/monetdb5/extras/rapi/Makefile.ag
+++ b/monetdb5/extras/rapi/Makefile.ag
@@ -40,8 +40,8 @@ headers_rapi_mal = {
headers_autoload = {
HEADERS = mal
DIR = libdir/monetdb5/autoload
- SOURCES = 00_rapi.mal
+ SOURCES = 50_rapi.mal
}
EXTRA_DIST_DIR = Tests
-EXTRA_DIST = 00_rapi.mal rapi.mal
+EXTRA_DIST = 50_rapi.mal rapi.mal
diff --git a/monetdb5/extras/rapi/rapi.c b/monetdb5/extras/rapi/rapi.c
--- a/monetdb5/extras/rapi/rapi.c
+++ b/monetdb5/extras/rapi/rapi.c
@@ -23,6 +23,15 @@
*/
#include "monetdb_config.h"
#include "rapi.h"
+//
+// R headers
+#include <Rembedded.h>
+#include <Rdefines.h>
+#define R_INTERFACE_PTRS
+#include <Rinterface.h>
+#include <Rinternals.h>
+#include <R_ext/Parse.h>
+
#include <string.h>
#define BAT_TO_INTSXP(bat,tpe,retsxp) { \
@@ -38,7 +47,7 @@
}
#define BAT_TO_REALSXP(bat,tpe,retsxp) { \
- tpe v; size_t j; \
+ tpe v; size_t j; \
retsxp = PROTECT(NEW_NUMERIC(BATcount(bat))); \
for (j = 0; j < BATcount(bat); j++) { \
v = ((tpe*) Tloc(bat, BUNfirst(bat)))[j]; \
@@ -49,6 +58,25 @@
}\
}
+#define SCALAR_TO_INTSXP(tpe,retsxp) { \
+ tpe v; \
+ retsxp = PROTECT(NEW_INTEGER(1)); \
+ v = *(tpe*) getArgReference(stk,pci,i); \
+ if ( v == tpe##_nil) \
+ INTEGER_POINTER(retsxp)[0] = NA_INTEGER; \
+ else \
+ INTEGER_POINTER(retsxp)[0] = (int)v; \
+}
+
+#define SCALAR_TO_REALSXP(tpe,retsxp) { \
+ tpe v; \
+ retsxp = PROTECT(NEW_NUMERIC(1)); \
+ v = * (tpe*) getArgReference(stk,pci,i); \
+ if ( v == tpe##_nil) \
+ NUMERIC_POINTER(retsxp)[0] = NA_REAL; \
+ else \
+ NUMERIC_POINTER(retsxp)[0] = (double)v; \
+}
#define SXP_TO_BAT(tpe,access_fun,na_check) { \
tpe *p, prev = tpe##_nil; \
b = BATnew(TYPE_void, TYPE_##tpe, cnt);\
@@ -102,9 +130,24 @@ static void RAPIinitialize(void) {
rapiInitialized++;
}
+static SEXP RAPInewEnvironment(Client cntxt)
+{
+ SEXP env;
+ char buf[128];
+
+ /* create new, empty environment */
+ /* ugly call required since Rf_NewEnvironment is not in the public
headers*/
+ snprintf(buf,128,"new.env%d",cntxt->idx);
+ env = PROTECT(eval(lang1(install(buf)),R_GlobalEnv));
+ assert(env != NULL);
+ return env;
+}
+
str RAPIeval(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci) {
str exprStr = *(str*) getArgReference(stk, pci, pci->retc);
SEXP x, env,retval;
+ SEXP varname = R_NilValue;
+ SEXP varvalue = R_NilValue;
ParseStatus status;
int i,j;
char buf[64] = "rapi";
@@ -128,10 +171,10 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
}
args = (str*) GDKzalloc(sizeof(str) * pci->argc);
- if (args == NULL)
+ if (args == NULL){
+ GDKfree(rcall);
throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
-
- MT_lock_set(&rapiLock, "rapi.evaluate");
+ }
#ifdef _RAPI_DEBUG_
mnstr_printf(cntxt->fdout, "# User R expression: %s\n", exprStr);
@@ -139,16 +182,12 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
(void) cntxt;
#endif
- /* create new, empty environment */
- /* ugly call required since Rf_NewEnvironment is not in the public
headers*/
- env = PROTECT(eval(lang1(install("new.env")),R_GlobalEnv));
- assert(env != NULL);
+ MT_lock_set(&rapiLock, "rapi.evaluate");
+ env = RAPInewEnvironment(cntxt);
// install the MAL variables into the R environment
// we can basically map values to int ("INTEGER") or double ("REAL")
for (i = pci->retc + 1; i < pci->argc; i++) {
- SEXP varname = R_NilValue;
- SEXP varvalue = R_NilValue;
// check for BAT or scalar first, keep code left
if (!isaBatType(getArgType(mb,pci,i))) {
msg = createException(MAL, "rapi.eval",
@@ -160,8 +199,10 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
varname = PROTECT(Rf_install(args[i]));
b = BATdescriptor(*(int*) getArgReference(stk, pci, i));
- if (b == NULL)
- throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
+ if (b == NULL){
+ msg= createException(MAL, "rapi.eval", MAL_MALLOC_FAIL);
+ goto wrapup;
+ }
switch (ATOMstorage(getTailType(getArgType(mb,pci,i)))) {
case TYPE_bte:
@@ -348,9 +389,307 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
}
wrapup:
MT_lock_unset(&rapiLock, "rapi.evaluate");
+ GDKfree(rcall);
GDKfree(args);
/* unprotect environment, so it will be eaten by the GC. */
UNPROTECT(1);
return msg;
}
+
+// Scalar function can be used within the SELECT and WHERE clause
+// They are parameterised with either scalars or BATs
+// The former should be turned into a singleton vector
+
+str RAPIevalScalar(Client cntxt, MalBlkPtr mb, MalStkPtr stk, InstrPtr pci)
+{
+ str exprStr = *(str*) getArgReference(stk, pci, pci->retc);
+ SEXP x, env,retval;
+ SEXP varname = R_NilValue;
+ SEXP varvalue = R_NilValue;
+ ParseStatus status;
+ int i,j;
+ char buf[64] = "rapi";
+ char argnames[1000] = "";
+ char* rcall;
+ size_t ret_rows = 0;
+ int ret_cols = 0; /* int because pci->retc is int, too*/
+ str *args;
+ int evalErr;
+ char *msg = createException(MAL, "rapi.scalar", "NYI");
+ BAT *b;
+ BUN cnt;
+
+ /* startup internal R environment if needed */
+ if (!rapiInitialized)
+ RAPIinitialize();
+
+ rcall = malloc(strlen(exprStr) + sizeof(argnames) + 100);
+ if (rcall==NULL)
+ throw(MAL, "rapi.scalar", MAL_MALLOC_FAIL);
+
+ args = (str*) GDKzalloc(sizeof(str) * pci->argc);
+ if (args == NULL){
+ GDKfree(rcall);
+ throw(MAL, "rapi.scalar", MAL_MALLOC_FAIL);
+ }
+
+#ifdef _RAPI_DEBUG_
+ mnstr_printf(cntxt->fdout, "# User R expression: %s\n", exprStr);
+#else
+ (void) cntxt;
+#endif
+
+ MT_lock_set(&rapiLock, "rapi.scalar");
+ env = RAPInewEnvironment(cntxt);
+
+ // install the MAL variables into the R environment
+ // we can basically map values to int ("INTEGER") or double ("REAL")
+ for (i = pci->retc + 1; i < pci->argc; i++) {
+
+ sprintf(buf, "arg%d", i - 1);
+ args[i] = GDKstrdup(buf);
+ varname = PROTECT(Rf_install(args[i]));
+
+
+ if (!isaBatType(getArgType(mb,pci,i))) {
+ b = BATdescriptor(*(int*) getArgReference(stk, pci, i));
+ if (b == NULL){
+ msg = createException(MAL, "rapi.scalar",
MAL_MALLOC_FAIL);
+ goto wrapup;
+ }
+ switch (ATOMstorage(getTailType(getArgType(mb,pci,i))))
{
+ case TYPE_bte:
+ BAT_TO_INTSXP(b,bte,varvalue);
+ break;
+ case TYPE_sht:
+ BAT_TO_INTSXP(b,sht,varvalue);
+ break;
+ case TYPE_int:
+ BAT_TO_INTSXP(b,int,varvalue);
+ break;
+ case TYPE_flt:
+ BAT_TO_REALSXP(b,flt,varvalue);
+ break;
+ case TYPE_dbl:
+ BAT_TO_REALSXP(b,dbl,varvalue);
+ break;
+ case TYPE_lng: /* R's integers are stored as int, so we
cannot be sure long will fit */
+ BAT_TO_REALSXP(b,lng,varvalue);
+ break;
+ case TYPE_str: { // there is only one string type, thus
no macro here
+ BUN p = 0, q = 0, j=0;
+ BATiter li;
+ li = bat_iterator(b);
+ varvalue = PROTECT(NEW_STRING(BATcount(b)));
+ BATloop(b, p, q) {
+ const char *t = (const char *)
BUNtail(li, p);
+ if (t == str_nil) {
+
SET_STRING_ELT(varvalue, j, NA_STRING);
+ } else {
+
SET_STRING_ELT(varvalue, j, mkCharCE(t,CE_UTF8));
+ }
+ j++;
+ }
+ }
+ break;
+ default:
+ // no clue what type to consider msg =
createException(MAL, "rapi.scalar",
+ msg = createException(MAL, "rapi.scalar",
"unknown argument type");
+ goto wrapup;
+ }
+ BBPreleaseref(b->batCacheid);
+ } else {
+ // pass a single scalar value around
+ switch (ATOMstorage(getTailType(getArgType(mb,pci,i))))
{
+ case TYPE_bte:
+ SCALAR_TO_INTSXP(bte,varvalue);
+ break;
+ case TYPE_sht:
+ SCALAR_TO_INTSXP(sht,varvalue);
+ break;
+ case TYPE_int:
+ SCALAR_TO_INTSXP(int,varvalue);
+ break;
+ case TYPE_flt:
+ SCALAR_TO_REALSXP(flt,varvalue);
+ break;
+ case TYPE_dbl:
+ SCALAR_TO_REALSXP(dbl,varvalue);
+ break;
+ case TYPE_lng: /* R's integers are stored as int, so we
cannot be sure long will fit */
+ SCALAR_TO_REALSXP(lng,varvalue);
+ break;
+ case TYPE_str:
+ { // there is only one string type, thus no macro here
+ const char *t = *(char **)
getArgReference(stk,pci,i);
+ varvalue = PROTECT(NEW_STRING(1));
+ if (t == str_nil) {
+ SET_STRING_ELT(varvalue, 0, NA_STRING);
+ } else {
+ SET_STRING_ELT(varvalue, 0,
mkCharCE(t,CE_UTF8));
+ }
+ }
+ break;
+ default:
+ msg = createException(MAL, "rapi.scalar",
"unknown argument type");
+ goto wrapup;
+ }
+ }
+
+ // install vector into R environment
+ Rf_defineVar(varname, varvalue, env);
+ UNPROTECT(2);
+ }
+
+ /* we are going to evaluate the user function within a anonymous
function call:
_______________________________________________
checkin-list mailing list
checkin-list@monetdb.org
https://www.monetdb.org/mailman/listinfo/checkin-list
