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 802b9db6f91f2b1d61bfd2eb21259a15fcfdfcc0..edcb77b445a99e56284a1126e33ca07b45544ddb 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 48cab2736216cb2c7790c7a6c2fa69c5eda0263c..4d6ac072c5ba151c2f0ca47ad22df74a74ad5413 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 64bb6b746dceaf12b0ba8c08f310b0426babde44..f5c89552bd3e62bfce023a230e90d141f7a46b2f 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 b10b83725e0ac1a99d8032e85d5cf8d2b3c17a6b..a5783eb3aaa5604a17734b19b1245e4508904209 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 ca91702c5e0675895817ff5ad0bc4db0c712c71e..e47d7a69e84048e9d039650065a9f73cc58245cf 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 28ab2aed241e631c6fd633dfe2dfc3e47fd95cdc..0721954ee062797dd9665fab25cda0c47c66f54d 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 981df927dac74a0ca0a7a4dccfb2dfb64103d7da..3570fbd380e33f17ff192da16728702fa01536a0 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 b378a50ecff075375707c94afe9f8418ee20ee03..8d8dceb5b0fb44bb7f028629b76c828b0a5ef5b8 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)