[GR-6814] [GR-6815] Small interop fixes regarding type conversion.

PullRequest: fastr/1238

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/BasePackage.java

@@ -431,6 +431,7 @@ public class BasePackage extends RBuiltinPackage {
         add(FastRInterop.InteropNew.class, FastRInteropFactory.InteropNewNodeGen::create);
         add(FastRInterop.IsNull.class, FastRInteropFactory.IsNullNodeGen::create);
         add(FastRInterop.IsExecutable.class, FastRInteropFactory.IsExecutableNodeGen::create);
+        add(FastRInterop.DoCallExternal.class, FastRInteropFactory.DoCallExternalNodeGen::create);
         add(FastRInterop.IsExternal.class, FastRInteropFactory.IsExternalNodeGen::create);
         add(FastRInterop.JavaClass.class, FastRInteropFactory.JavaClassNodeGen::create);
         add(FastRInterop.JavaClassName.class, FastRInteropFactory.JavaClassNameNodeGen::create);

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

@@ -84,10 +84,12 @@ import com.oracle.truffle.r.runtime.data.RNull;
 import com.oracle.truffle.r.runtime.data.RRaw;
 import com.oracle.truffle.r.runtime.data.model.RAbstractDoubleVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractListVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractLogicalVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractRawVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractVector;
+import com.oracle.truffle.r.runtime.data.nodes.GetReadonlyData;
 import com.oracle.truffle.r.runtime.interop.Foreign2R;
 import com.oracle.truffle.r.runtime.interop.ForeignArray2R;
 import com.oracle.truffle.r.runtime.interop.R2Foreign;
@@ -867,4 +869,49 @@ public class FastRInterop {
         }
         return Class.forName(className);
     }
+
+    @RBuiltin(name = "do.call.external", visibility = ON, kind = PRIMITIVE, parameterNames = {"receiver", "what", "args"}, behavior = COMPLEX)
+    public abstract static class DoCallExternal extends RBuiltinNode.Arg3 {
+
+        static {
+            Casts casts = new Casts(DoCallExternal.class);
+            casts.arg("args").mustBe(RAbstractListVector.class, RError.Message.GENERIC, "third argument must be a list");
+        }
+
+        @Child private GetReadonlyData.ListData getDataNode;
+
+        protected Node createInvoke(int nargs) {
+            return Message.createInvoke(nargs).createNode();
+        }
+
+        @Specialization
+        public Object invoke(TruffleObject obj, String what, RAbstractListVector args,
+                        @Cached("create()") Foreign2R foreign2R,
+                        @Cached("create()") R2Foreign r2Foreign,
+                        @Cached("createInvoke(args.getLength())") Node invokeNode) {
+
+            if (getDataNode == null) {
+                getDataNode = insert(GetReadonlyData.ListData.create());
+            }
+
+            Object[] argValues = getDataNode.execute(args);
+            for (int i = 0; i < argValues.length; i++) {
+                argValues[i] = r2Foreign.execute(argValues[i]);
+            }
+            try {
+                return foreign2R.execute(ForeignAccess.sendInvoke(invokeNode, obj, what, argValues));
+            } catch (UnsupportedTypeException e) {
+                throw error(RError.Message.GENERIC, "Invalid argument types provided");
+            } catch (ArityException e) {
+                throw error(RError.Message.INVALID_ARG_NUMBER, what);
+            } catch (UnknownIdentifierException e) {
+                throw error(RError.Message.UNKNOWN_FUNCTION, what);
+            } catch (UnsupportedMessageException e) {
+                throw error(RError.Message.MUST_BE_STRING_OR_FUNCTION, "what");
+            } catch (RuntimeException e) {
+                throw error(RError.Message.GENERIC, e.getMessage());
+            }
+        }
+    }
+
 }

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

@@ -272,12 +272,14 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
                     @Cached("create()") GetBaseEnvFrameNode getBaseEnvFrameNode,
                     @Cached("createBinaryProfile()") ConditionProfile isS4Profile,
                     @Cached("new()") PromiseCheckHelperNode promiseHelper) {
+
         RBuiltinDescriptor builtin = builtinProfile.profile(function.getRBuiltin());
         Object dispatchObject = dispatchArgument.execute(frame);
         // Cannot dispatch on REmpty
         if (dispatchObject == REmpty.instance) {
             throw error(RError.Message.ARGUMENT_EMPTY, 1);
         }
+
         FrameSlot slot = dispatchTempSlot.initialize(frame, dispatchObject);
         try {
             if (internalDispatchCall == null) {
@@ -287,7 +289,7 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
 
             if (isAttributableProfile.profile(dispatchObject instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) dispatchObject).isS4())) {
                 RList list = (RList) promiseHelper.checkEvaluate(frame, REnvironment.getRegisteredNamespace("methods").get(".BasicFunsList"));
-                // TODO create a node that looksup the name in the names attribute
+                // TODO create a node that looks up the name in the names attribute
                 int index = list.getElementIndexByName(builtin.getName());
                 if (index != -1) {
                     RFunction basicFun = (RFunction) list.getDataAt(index);
@@ -341,7 +343,7 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
 
         if (isAttributableProfile.profile(dispatchObject instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) dispatchObject).isS4())) {
             RList list = (RList) promiseHelperNode.checkEvaluate(frame, REnvironment.getRegisteredNamespace("methods").get(".BasicFunsList"));
-            // TODO create a node that looksup the name in the names attribute
+            // TODO create a node that looks up the name in the names attribute
             int index = list.getElementIndexByName(builtin.getName());
             if (index != -1) {
                 RFunction basicFun = (RFunction) list.getDataAt(index);
@@ -543,27 +545,36 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
 
     protected final class ForeignCall extends Node {
 
-        @Child private CallArgumentsNode arguments;
-        @Child private Node foreignCall;
-        @CompilationFinal private int foreignCallArgCount;
+        @Child protected CallArgumentsNode arguments;
+        @Child protected Node messageNode;
+        @CompilationFinal protected int foreignCallArgCount;
+        @Child protected Foreign2R foreign2RNode;
+        @Child protected R2Foreign r2ForeignNode;
 
         public ForeignCall(CallArgumentsNode arguments) {
             this.arguments = arguments;
         }
 
-        public Object execute(VirtualFrame frame, TruffleObject function, Foreign2R foreign2R, R2Foreign r2Foreign) {
-            Object[] argumentsArray = explicitArgs != null ? ((RArgsValuesAndNames) explicitArgs.execute(frame)).getArguments() : arguments.evaluateFlattenObjects(frame, lookupVarArgs(frame));
-            if (foreignCall == null || foreignCallArgCount != argumentsArray.length) {
+        protected Object[] evaluateArgs(VirtualFrame frame) {
+            return explicitArgs != null ? ((RArgsValuesAndNames) explicitArgs.execute(frame)).getArguments() : arguments.evaluateFlattenObjects(frame, lookupVarArgs(frame));
+        }
+
+        protected Object execute(VirtualFrame frame, TruffleObject function) {
+            Object[] argumentsArray = evaluateArgs(frame);
+            if (messageNode == null || foreignCallArgCount != argumentsArray.length) {
                 CompilerDirectives.transferToInterpreterAndInvalidate();
-                foreignCall = insert(Message.createExecute(argumentsArray.length).createNode());
+                messageNode = insert(Message.createExecute(argumentsArray.length).createNode());
                 foreignCallArgCount = argumentsArray.length;
+                foreign2RNode = insert(Foreign2R.create());
+                r2ForeignNode = insert(R2Foreign.create());
             }
+
             try {
                 for (int i = 0; i < argumentsArray.length; i++) {
-                    argumentsArray[i] = r2Foreign.execute(argumentsArray[i]);
+                    argumentsArray[i] = r2ForeignNode.execute(argumentsArray[i]);
                 }
-                Object result = ForeignAccess.sendExecute(foreignCall, function, argumentsArray);
-                return foreign2R.execute(result);
+                Object result = ForeignAccess.sendExecute(messageNode, function, argumentsArray);
+                return foreign2RNode.execute(result);
             } catch (ArityException | UnsupportedMessageException | UnsupportedTypeException e) {
                 CompilerDirectives.transferToInterpreter();
                 RInternalError.reportError(e);
@@ -582,10 +593,8 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS
 
     @Specialization(guards = "isForeignObject(function)")
     public Object call(VirtualFrame frame, TruffleObject function,
-                    @Cached("createForeignCall()") ForeignCall foreignCall,
-                    @Cached("create()") Foreign2R foreign2RNode,
-                    @Cached("create()") R2Foreign r2Foreign) {
-        return foreignCall.execute(frame, function, foreign2RNode, r2Foreign);
+                    @Cached("createForeignCall()") ForeignCall foreignCall) {
+        return foreignCall.execute(frame, function);
     }
 
     @TruffleBoundary

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/data/nodes/GetReadonlyData.java

@@ -24,10 +24,13 @@ package com.oracle.truffle.r.runtime.data.nodes;
 
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.api.nodes.Node;
+import com.oracle.truffle.r.runtime.RInternalError;
 import com.oracle.truffle.r.runtime.data.NativeDataAccess;
 import com.oracle.truffle.r.runtime.data.RDoubleVector;
 import com.oracle.truffle.r.runtime.data.RIntVector;
+import com.oracle.truffle.r.runtime.data.RList;
 import com.oracle.truffle.r.runtime.data.RVector;
+import com.oracle.truffle.r.runtime.data.model.RAbstractListVector;
 
 /**
  * Nodes contained in this class return an array that is either directly backing the vector data, or
@@ -74,4 +77,27 @@ public class GetReadonlyData {
             return GetReadonlyDataFactory.IntNodeGen.create();
         }
     }
+
+    public abstract static class ListData extends Node {
+        public abstract Object[] execute(RAbstractListVector vector);
+
+        @Specialization(guards = "!vec.hasNativeMemoryData()")
+        protected Object[] doManagedRVector(RList vec) {
+            return vec.getInternalManagedData();
+        }
+
+        @Specialization(guards = "vec.hasNativeMemoryData()")
+        protected Object[] doNativeDataRVector(@SuppressWarnings("unused") RList vec) {
+            throw RInternalError.shouldNotReachHere("list cannot have native memory");
+        }
+
+        @Specialization
+        protected Object[] doGeneric(RAbstractListVector vec) {
+            return vec.materialize().getInternalManagedData();
+        }
+
+        public static ListData create() {
+            return GetReadonlyDataFactory.ListDataNodeGen.create();
+        }
+    }
 }

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/interop/ForeignArray2R.java

@@ -193,7 +193,7 @@ public abstract class ForeignArray2R extends RBaseNode {
             CompilerDirectives.transferToInterpreterAndInvalidate();
             foreignArray2R = insert(create());
         }
-        foreignArray2R.execute(element, true, arrayData, ++depth);
+        foreignArray2R.execute(element, true, arrayData, depth + 1);
     }
 
     private Foreign2R getForeign2R() {
@@ -421,6 +421,8 @@ public abstract class ForeignArray2R extends RBaseNode {
             if (this.type != RType.NONE) {
                 if (this.type == null) {
                     this.type = check;
+                } else if (this.type == RType.INTEGER && check == RType.DOUBLE || check == RType.INTEGER && this.type == RType.DOUBLE) {
+                    this.type = RType.DOUBLE;
                 } else if (this.type != check) {
                     this.type = RType.NONE;
                 }