various interop fixes and improvements

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/fastr/FastRInterop.java

@@ -25,13 +25,20 @@ package com.oracle.truffle.r.nodes.builtin.fastr;
 import java.io.IOException;
 
 import com.oracle.truffle.api.CallTarget;
+import com.oracle.truffle.api.CompilerAsserts;
 import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.api.Truffle;
+import com.oracle.truffle.api.dsl.Cached;
 import com.oracle.truffle.api.dsl.Specialization;
+import com.oracle.truffle.api.frame.VirtualFrame;
+import com.oracle.truffle.api.nodes.DirectCallNode;
 import com.oracle.truffle.api.source.Source;
+import com.oracle.truffle.r.nodes.builtin.CastBuilder;
 import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
 import com.oracle.truffle.r.runtime.RBuiltin;
 import com.oracle.truffle.r.runtime.RBuiltinKind;
 import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RError.Message;
 import com.oracle.truffle.r.runtime.RRuntime;
 import com.oracle.truffle.r.runtime.RSource;
 import com.oracle.truffle.r.runtime.RVisibility;
@@ -43,21 +50,41 @@ public class FastRInterop {
     @RBuiltin(name = ".fastr.interop.eval", visibility = RVisibility.OFF, kind = RBuiltinKind.PRIMITIVE, parameterNames = {"mimeType", "source"})
     public abstract static class Eval extends RBuiltinNode {
 
-        @Specialization
-        @TruffleBoundary
-        protected Object interopEval(Object mimeType, Object source) {
-            Source sourceObject = RSource.fromTextInternal(RRuntime.asString(source), RSource.Internal.EVAL_WRAPPER, RRuntime.asString(mimeType));
+        @Override
+        protected void createCasts(CastBuilder casts) {
+            casts.firstStringWithError(0, Message.INVALID_ARGUMENT, "mimeType");
+            casts.firstStringWithError(1, Message.INVALID_ARGUMENT, "source");
+        }
 
-            CallTarget callTarget;
+        protected CallTarget parse(String mimeType, String source) {
+            CompilerAsserts.neverPartOfCompilation();
 
+            Source sourceObject = RSource.fromTextInternal(source, RSource.Internal.EVAL_WRAPPER, mimeType);
             try {
-                callTarget = RContext.getInstance().getEnv().parse(sourceObject);
                 emitIO();
+                return RContext.getInstance().getEnv().parse(sourceObject);
             } catch (IOException e) {
-                throw new RuntimeException(e);
+                throw RError.error(this, Message.GENERIC, "Error while parsing: " + e.getMessage());
             }
+        }
+
+        protected DirectCallNode createCall(String mimeType, String source) {
+            return Truffle.getRuntime().createDirectCallNode(parse(mimeType, source));
+        }
 
-            return callTarget.call();
+        @SuppressWarnings("unused")
+        @Specialization(guards = {"cachedMimeType != null", "cachedMimeType.equals(mimeType)", "cachedSource != null", "cachedSource.equals(source)"})
+        protected Object evalCached(VirtualFrame frame, String mimeType, String source, //
+                        @Cached("mimeType") String cachedMimeType, //
+                        @Cached("source") String cachedSource, //
+                        @Cached("createCall(mimeType, source)") DirectCallNode call) {
+            return call.call(frame, EMPTY_OBJECT_ARRAY);
+        }
+
+        @Specialization(contains = "evalCached")
+        @TruffleBoundary
+        protected Object eval(String mimeType, String source) {
+            return parse(mimeType, source).call();
         }
 
         @SuppressWarnings("unused")

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/ExtractVectorNode.java

@@ -32,6 +32,7 @@ import com.oracle.truffle.api.interop.InteropException;
 import com.oracle.truffle.api.interop.Message;
 import com.oracle.truffle.api.interop.TruffleObject;
 import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.api.profiles.ValueProfile;
 import com.oracle.truffle.r.nodes.binary.BoxPrimitiveNode;
 import com.oracle.truffle.r.nodes.profile.TruffleBoundaryNode;
 import com.oracle.truffle.r.nodes.unary.CastStringNode;
@@ -108,18 +109,23 @@ public abstract class ExtractVectorNode extends Node {
                     @Cached("createForeignRead(positions)") Node foreignRead, //
                     @Cached("positions.length") int cachedLength, //
                     @Cached("create()") CastStringNode castNode, //
-                    @Cached("createFirstString()") FirstStringNode firstString) {
-        Object position = positions[0];
+                    @Cached("createFirstString()") FirstStringNode firstString, //
+                    @Cached("createClassProfile()") ValueProfile positionProfile) {
+        Object position = positionProfile.profile(positions[0]);
         try {
-            if (position instanceof String || position instanceof Double || position instanceof Integer) {
+            if (position instanceof Integer) {
+                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((int) position) - 1});
+            } else if (position instanceof Double) {
+                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((double) position) - 1});
+            } else if (position instanceof String) {
                 return ForeignAccess.send(foreignRead, frame, object, new Object[]{position});
             } else if (position instanceof RAbstractStringVector) {
                 String string = firstString.executeString(castNode.execute(position));
                 return ForeignAccess.send(foreignRead, frame, object, new Object[]{string});
             } else if (position instanceof RAbstractDoubleVector) {
-                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((RAbstractDoubleVector) position).getDataAt(0)});
+                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((RAbstractDoubleVector) position).getDataAt(0) - 1});
             } else if (position instanceof RAbstractIntVector) {
-                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((RAbstractIntVector) position).getDataAt(0)});
+                return ForeignAccess.send(foreignRead, frame, object, new Object[]{((RAbstractIntVector) position).getDataAt(0) - 1});
             } else {
                 throw RError.error(this, RError.Message.GENERIC, "invalid index during foreign access");
             }

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/RCallNode.java

@@ -520,7 +520,6 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
             this.arguments = arguments;
         }
 
-        @SuppressWarnings("deprecation")
         public Object execute(VirtualFrame frame, TruffleObject function) {
             Object[] argumentsArray = explicitArgs != null ? ((RArgsValuesAndNames) explicitArgs.execute(frame)).getArguments() : arguments.evaluateFlattenObjects(frame, lookupVarArgs(frame));
             if (foreignCall == null || foreignCallArgCount != argumentsArray.length) {
@@ -529,7 +528,7 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
                 foreignCallArgCount = argumentsArray.length;
             }
             try {
-                Object result = ForeignAccess.execute(foreignCall, frame, function, argumentsArray);
+                Object result = ForeignAccess.sendExecute(foreignCall, frame, function, argumentsArray);
                 if (result instanceof Boolean) {
                     // convert to R logical
                     // TODO byte/short convert to int?

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test

@@ -106750,36 +106750,52 @@ a b c d
 a b c d e
 1 2 3 4 5
+##com.oracle.truffle.r.test.library.fastr.TestInteropEval.testInteropEval
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { 1 } else { .fastr.interop.eval('application/x-r', '1') }
+[1] 1
+
 ##com.oracle.truffle.r.test.library.fastr.TestInteropEval.testInteropEval
 #if (length(grep("FastR", R.Version()$version.string)) != 1) { 16 } else { .fastr.interop.eval('application/x-r', '14 + 2') }
 [1] 16
+##com.oracle.truffle.r.test.library.fastr.TestInteropEval.testInteropEval
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { 1L } else { .fastr.interop.eval('application/x-r', '1L') }
+[1] 1
+
+##com.oracle.truffle.r.test.library.fastr.TestInteropEval.testInteropEval
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { .fastr.interop.eval('application/x-r', 'TRUE') }
+[1] TRUE
+
+##com.oracle.truffle.r.test.library.fastr.TestInteropEval.testInteropEval
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { as.character(123) } else { .fastr.interop.eval('application/x-r', 'as.character(123)') }
+[1] "123"
+
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { 1 } else { f<-function(x) fastr.refcountinfo(x); f(c(1,2)) }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { 1 } else { { f<-function(x) fastr.refcountinfo(x); f(c(1,2)) } }
 [1] 1
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { 2 } else { f<-function(x) { y<-x; fastr.refcountinfo(y) }; f(c(1,2)) }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { 2 } else { { f<-function(x) { y<-x; fastr.refcountinfo(y) }; f(c(1,2)) } }
 [1] 2
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { 2 } else { x<-c(1,2); f<-function(x) fastr.refcountinfo(x); f(x) }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { 2 } else { { x<-c(1,2); f<-function(x) fastr.refcountinfo(x); f(x) } }
 [1] 2
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { FALSE } else { f<-function(y) { x<-y; xi1<-fastr.identity(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }; f(c(1,2)) }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { FALSE } else { { f<-function(y) { x<-y; xi1<-fastr.identity(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }; f(c(1,2)) } }
 [1] FALSE
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { f<-function(x) { xi1<-fastr.identity(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }; f(c(1,2)) }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { { f<-function(x) { xi1<-fastr.identity(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }; f(c(1,2)) } }
 [1] TRUE
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { x<-rep(1, 100); xi1<-fastr.identity(x); f<-function(x) { x }; f(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { { x<-rep(1, 100); xi1<-fastr.identity(x); f<-function(x) { x }; f(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 } }
 [1] TRUE
 ##com.oracle.truffle.r.test.library.fastr.TestStateTrans.testTransitions
-#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { x<-rep(1, 100); xi1<-fastr.identity(x); f<-function(x) { y<-x; y }; f(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 }
+#if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { { x<-rep(1, 100); xi1<-fastr.identity(x); f<-function(x) { y<-x; y }; f(x); x[1]<-7; xi2<-fastr.identity(x); xi1 == xi2 } }
 [1] TRUE
 ##com.oracle.truffle.r.test.library.stats.TestFitting.testLm

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/TestBase.java

@@ -388,7 +388,7 @@ public class TestBase {
 
     // support testing of FastR-only functionality (equivalent GNU R output provided separately)
     protected void assertEvalFastR(String input, String gnuROutput) {
-        evalAndCompare(new String[]{"if (length(grep(\"FastR\", R.Version()$version.string)) != 1) { " + gnuROutput + " } else " + input});
+        evalAndCompare(new String[]{"if (length(grep(\"FastR\", R.Version()$version.string)) != 1) { " + gnuROutput + " } else { " + input + " }"});
     }
 
     /*

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/fastr/TestInteropEval.java

@@ -30,6 +30,10 @@ public class TestInteropEval extends TestBase {
 
     @Test
     public void testInteropEval() {
-        assertEvalFastR("{ .fastr.interop.eval('application/x-r', '14 + 2') }", "16");
+        assertEvalFastR(".fastr.interop.eval('application/x-r', '14 + 2')", "16");
+        assertEvalFastR(".fastr.interop.eval('application/x-r', '1')", "1");
+        assertEvalFastR(".fastr.interop.eval('application/x-r', '1L')", "1L");
+        assertEvalFastR(".fastr.interop.eval('application/x-r', 'TRUE')", "TRUE");
+        assertEvalFastR(".fastr.interop.eval('application/x-r', 'as.character(123)')", "as.character(123)");
     }
 }

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/tck/FastRTckTest.java

@@ -83,7 +83,7 @@ public class FastRTckTest extends TruffleTCK {
         ".fastr.interop.export('countUpWhile', countUpWhile)\n" +
         "complexSumReal <- function(a) {\n" +
         " sum <- 0\n" +
-        " for (i in 0:(length(a)-1)) {\n" +
+        " for (i in 1:length(a)) {\n" +
         "   sum <- sum + a[i]$real\n" +
         " }\n" +
         " return(sum)\n" +