From 6b7fde25f073220794e0b288b9c7070706f3bf35 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Mon, 25 Sep 2017 18:10:06 +0200
Subject: [PATCH] FFI: implement SETCARD as node

---
 .../ffi/impl/common/JavaUpCallsRFFIImpl.java  | 13 ++-----
 .../r/ffi/impl/nodes/ListAccessNodes.java     | 36 +++++++++++++++++++
 .../r/ffi/impl/upcalls/StdUpCallsRFFI.java    |  4 +++
 3 files changed, 42 insertions(+), 11 deletions(-)

diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
index b459887c3e..81e8940e45 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/common/JavaUpCallsRFFIImpl.java
@@ -688,15 +688,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
 
     @Override
     public Object SETCAR(Object x, Object y) {
-        RPairList pl;
-        if (x instanceof RLanguage) {
-            pl = ((RLanguage) x).getPairList();
-        } else {
-            guaranteeInstanceOf(x, RPairList.class);
-            pl = (RPairList) x;
-        }
-        pl.setCar(y);
-        return y;
+        throw implementedAsNode();
     }
 
     @Override
@@ -708,8 +700,7 @@ public abstract class JavaUpCallsRFFIImpl implements UpCallsRFFI {
 
     @Override
     public Object SETCADR(Object x, Object y) {
-        SETCAR(CDR(x), y);
-        return y;
+        throw implementedAsNode();
     }
 
     @Override
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
index a5a57f7b33..051567f2a2 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
@@ -31,6 +31,7 @@ import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADRNodeGen;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CARNodeGen;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDDRNodeGen;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDRNodeGen;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.SETCARNodeGen;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetNamesAttributeNode;
 import com.oracle.truffle.r.runtime.RInternalError;
@@ -93,6 +94,41 @@ public final class ListAccessNodes {
         }
     }
 
+    @TypeSystemReference(RTypes.class)
+    public static final class SETCADRNode extends FFIUpCallNode.Arg2 {
+        @Child private SETCARNode setcarNode = SETCARNode.create();
+        @Child private CDRNode cdrNode = CDRNode.create();
+
+        @Override
+        public Object executeObject(Object x, Object y) {
+            return setcarNode.executeObject(cdrNode.executeObject(x), y);
+        }
+    }
+
+    @TypeSystemReference(RTypes.class)
+    public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
+        public static SETCARNode create() {
+            return SETCARNodeGen.create();
+        }
+
+        @Specialization
+        protected Object doRLang(RLanguage x, Object y) {
+            x.getPairList().setCar(y);
+            return y;
+        }
+
+        @Specialization
+        protected Object doRLang(RPairList x, Object y) {
+            x.setCar(y);
+            return y;
+        }
+
+        @Fallback
+        protected Object car(@SuppressWarnings("unused") Object x, @SuppressWarnings("unused") Object y) {
+            throw RInternalError.unimplemented("SETCAR only works on pair lists or language objects");
+        }
+    }
+
     @TypeSystemReference(RTypes.class)
     public abstract static class CDRNode extends FFIUpCallNode.Arg1 {
         @Specialization
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
index d6dff9a1df..ff460ed405 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/upcalls/StdUpCallsRFFI.java
@@ -36,6 +36,8 @@ import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CADRNode;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CARNode;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDDRNode;
 import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.CDRNode;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCADRNode;
+import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodes.SETCARNode;
 import com.oracle.truffle.r.ffi.impl.nodes.MatchNodes;
 import com.oracle.truffle.r.ffi.impl.nodes.MiscNodes;
 import com.oracle.truffle.r.ffi.impl.nodes.MiscNodes.LENGTHNode;
@@ -208,10 +210,12 @@ public interface StdUpCallsRFFI {
 
     Object SET_TAG(Object x, Object y);
 
+    @RFFIUpCallNode(SETCARNode.class)
     Object SETCAR(Object x, Object y);
 
     Object SETCDR(Object x, Object y);
 
+    @RFFIUpCallNode(SETCADRNode.class)
     Object SETCADR(Object x, Object y);
 
     Object SYMVALUE(Object x);
-- 
GitLab