Implement RFFI inlined length for REnvironment + tests

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();

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;
     }
 }
 

com.oracle.truffle.r.native/version.source

-30
+32

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)
 }

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),

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);

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);

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)