From 4c5a43e2d5ef0dcf98eb098c7beeafb4725f0778 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Fri, 21 Jul 2017 12:41:47 +0200
Subject: [PATCH] Implement RFFI inlined length for REnvironment + tests
---
.../truffle/r/ffi/impl/nodes/MiscNodes.java | 11 ++++++++++
.../fficall/src/common/inlined_fastr.c | 20 +++++++++----------
com.oracle.truffle.r.native/version.source | 2 +-
.../packages/testrffi/testrffi/R/testrffi.R | 4 ++++
.../packages/testrffi/testrffi/src/init.c | 1 +
.../packages/testrffi/testrffi/src/testrffi.c | 4 ++++
.../packages/testrffi/testrffi/src/testrffi.h | 2 ++
.../testrffi/testrffi/tests/simpleTests.R | 17 ++++++++++++++++
8 files changed, 50 insertions(+), 11 deletions(-)
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
index 802b9db6f9..edcb77b445 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/MiscNodes.java
@@ -23,9 +23,11 @@
package com.oracle.truffle.r.ffi.impl.nodes;
import com.oracle.truffle.api.CompilerDirectives;
+import com.oracle.truffle.api.dsl.Cached;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.dsl.TypeSystemReference;
+import com.oracle.truffle.api.profiles.ValueProfile;
import com.oracle.truffle.r.nodes.access.AccessSlotNode;
import com.oracle.truffle.r.nodes.access.AccessSlotNodeGen;
import com.oracle.truffle.r.nodes.access.UpdateSlotNode;
@@ -38,6 +40,7 @@ import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RSymbol;
import com.oracle.truffle.r.runtime.data.RTypes;
import com.oracle.truffle.r.runtime.data.model.RAbstractContainer;
+import com.oracle.truffle.r.runtime.env.REnvironment;
import com.oracle.truffle.r.runtime.ffi.CharSXPWrapper;
import com.oracle.truffle.r.runtime.gnur.SEXPTYPE;
@@ -82,6 +85,14 @@ public final class MiscNodes {
return obj.getLength();
}
+ @Specialization
+ protected int length(REnvironment env,
+ @Cached("createClassProfile()") ValueProfile frameAccessProfile) {
+ // May seem wasteful of resources, but simple env.getFrame().getDescriptor().getSize()
+ // is not correct!
+ return env.ls(true, null, false).getLength();
+ }
+
@Specialization
protected int length(RArgsValuesAndNames obj) {
return obj.getLength();
diff --git a/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c b/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
index 48cab27362..4d6ac072c5 100644
--- a/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
+++ b/com.oracle.truffle.r.native/fficall/src/common/inlined_fastr.c
@@ -35,7 +35,7 @@ INLINE_FUN R_len_t length(SEXP s)
int i;
switch (TYPEOF(s)) {
case NILSXP:
- return 0;
+ return 0;
case LGLSXP:
case INTSXP:
case REALSXP:
@@ -46,13 +46,14 @@ INLINE_FUN R_len_t length(SEXP s)
case EXPRSXP:
case RAWSXP:
case DOTSXP:
- return LENGTH(s);
+ case ENVSXP:
case LISTSXP:
case LANGSXP:
- case ENVSXP:
- return Rf_envlength(s);
+ // Note: all these types should have specialization in MiscNodes$LENGTHNode
+ return LENGTH(s);
default:
- return 1;
+ // e.g. SYMSXP (symbol), CLOSXP (closure)
+ return 1;
}
}
@@ -61,7 +62,7 @@ INLINE_FUN R_xlen_t xlength(SEXP s)
int i;
switch (TYPEOF(s)) {
case NILSXP:
- return 0;
+ return 0;
case LGLSXP:
case INTSXP:
case REALSXP:
@@ -72,13 +73,12 @@ INLINE_FUN R_xlen_t xlength(SEXP s)
case EXPRSXP:
case RAWSXP:
case DOTSXP:
- return XLENGTH(s);
+ case ENVSXP:
case LISTSXP:
case LANGSXP:
- case ENVSXP:
- return Rf_envlength(s);
+ return XLENGTH(s);
default:
- return 1;
+ return 1;
}
}
diff --git a/com.oracle.truffle.r.native/version.source b/com.oracle.truffle.r.native/version.source
index 64bb6b746d..f5c89552bd 100644
--- a/com.oracle.truffle.r.native/version.source
+++ b/com.oracle.truffle.r.native/version.source
@@ -1 +1 @@
-30
+32
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
index b10b83725e..a5783eb3aa 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/R/testrffi.R
@@ -153,6 +153,10 @@ rffi.LENGTH <- function(x) {
.Call("test_LENGTH", x)
}
+rffi.inlined_length <- function(x) {
+ .Call("test_inlined_length", x)
+}
+
rffi.coerceVector <- function(x, mode) {
.Call("test_coerceVector", x, mode)
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c
index ca91702c5e..e47d7a69e8 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/init.c
@@ -71,6 +71,7 @@ static const R_CallMethodDef CallEntries[] = {
CALLDEF(test_CAR, 1),
CALLDEF(test_CDR, 1),
CALLDEF(test_LENGTH, 1),
+ CALLDEF(test_inlined_length, 1),
CALLDEF(test_coerceVector, 2),
CALLDEF(test_ATTRIB, 1),
CALLDEF(test_stringNA, 0),
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
index 28ab2aed24..0721954ee0 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.c
@@ -318,6 +318,10 @@ SEXP test_LENGTH(SEXP x) {
return ScalarInteger(LENGTH(x));
}
+SEXP test_inlined_length(SEXP x) {
+ return ScalarInteger(length(x));
+}
+
SEXP test_coerceVector(SEXP x, SEXP mode) {
int intMode = INTEGER_VALUE(mode);
return Rf_coerceVector(x, intMode);
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h
index 981df927da..3570fbd380 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/src/testrffi.h
@@ -86,6 +86,8 @@ extern SEXP test_CDR(SEXP x);
extern SEXP test_LENGTH(SEXP x);
+extern SEXP test_inlined_length(SEXP x);
+
extern SEXP test_coerceVector(SEXP x, SEXP mode);
extern SEXP test_ATTRIB(SEXP);
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
index b378a50ecf..8d8dceb5b0 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
@@ -42,3 +42,20 @@ bar <- function() rffi.captureDotsWithSingleElement(parent.frame())
promiseInfo <- foo(tmp)
stopifnot('some_unique_name' %in% ls(promiseInfo[[2]]))
eval(promiseInfo[[1]], promiseInfo[[2]])
+
+# legth tests
+env <- new.env(); env$a <- 42; env$b <- 44;
+rffi.inlined_length(env)
+rffi.inlined_length(c(1,2,3))
+rffi.inlined_length(list(a = 1, b = 42))
+rffi.inlined_length(as.pairlist(c(1,2,3,4,5)))
+expr <- expression(x + y, 3)
+rffi.inlined_length(expr)
+rffi.inlined_length(expr[[1]])
+
+# fails in FastR because DotCall class cannot recognize that the RArgsValuesAndNames
+# are not meant to be extracted into individual arguments, but instead send as is
+# to the native function as SEXP
+#
+# foo <-function(...) rffi.inlined_length(get('...'))
+# foo(a = 1, b = 2, c = 3, d = 42)
--
GitLab