Added support for slot functions in methods package.

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/methods/Slot.java

+/*
+ * This material is distributed under the GNU General Public License
+ * Version 2. You may review the terms of this license at
+ * http://www.gnu.org/licenses/gpl-2.0.html
+ *
+ * Copyright (c) 1995-2013, The R Core Team
+ * Copyright (c) 2003, The R Foundation
+ * Copyright (c) 2015, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+package com.oracle.truffle.r.library.methods;
+
+import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
+import com.oracle.truffle.api.dsl.*;
+import com.oracle.truffle.r.nodes.access.AccessSlotNode;
+import com.oracle.truffle.r.nodes.access.AccessSlotNodeGen;
+import com.oracle.truffle.r.nodes.access.UpdateSlotNode;
+import com.oracle.truffle.r.nodes.access.UpdateSlotNodeGen;
+import com.oracle.truffle.r.nodes.builtin.*;
+import com.oracle.truffle.r.runtime.*;
+import com.oracle.truffle.r.runtime.context.*;
+import com.oracle.truffle.r.runtime.data.*;
+import com.oracle.truffle.r.runtime.data.model.*;
+import com.oracle.truffle.r.runtime.env.*;
+
+// Transcribed from src/library/methods/slot.c
+
+public class Slot {
+
+    public abstract static class R_getSlot extends RExternalBuiltinNode.Arg2 {
+
+        @Child AccessSlotNode accessSlotNode = AccessSlotNodeGen.create(null, null);
+
+        @Specialization(guards = "nameVec.getLength() == 1")
+        protected Object getSlot(Object object, RAbstractStringVector nameVec) {
+            return accessSlotNode.executeAccess(object, nameVec.getDataAt(0));
+        }
+
+        @SuppressWarnings("unused")
+        @Fallback
+        protected Object getSlot(Object object, Object nameVec) {
+            throw RError.error(this, RError.Message.GENERIC, "invalid type or length for slot name");
+        }
+
+    }
+
+    public abstract static class R_setSlot extends RExternalBuiltinNode.Arg3 {
+
+        @Child UpdateSlotNode updateSlotNode = UpdateSlotNodeGen.create(null, null, null);
+
+        @Specialization(guards = "nameVec.getLength() == 1")
+        protected Object setSlot(Object object, RAbstractStringVector nameVec, Object value) {
+            return updateSlotNode.executeUpdate(object, nameVec.getDataAt(0), value);
+        }
+
+        @SuppressWarnings("unused")
+        @Fallback
+        protected Object setSlot(Object object, Object name, Object value) {
+            throw RError.error(this, RError.Message.GENERIC, "invalid type or length for slot name");
+        }
+
+    }
+
+}

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/ForeignFunctions.java

@@ -27,6 +27,8 @@ import com.oracle.truffle.r.library.methods.MethodsListDispatchFactory.R_identCN
 import com.oracle.truffle.r.library.methods.MethodsListDispatchFactory.R_initMethodDispatchNodeGen;
 import com.oracle.truffle.r.library.methods.MethodsListDispatchFactory.R_methodsPackageMetaNameNodeGen;
 import com.oracle.truffle.r.library.methods.MethodsListDispatchFactory.R_set_method_dispatchNodeGen;
+import com.oracle.truffle.r.library.methods.SlotFactory.R_getSlotNodeGen;
+import com.oracle.truffle.r.library.methods.SlotFactory.R_setSlotNodeGen;
 import com.oracle.truffle.r.library.stats.Covcor;
 import com.oracle.truffle.r.library.stats.GammaFunctionsFactory.QgammaNodeGen;
 import com.oracle.truffle.r.library.stats.RnormNodeGen;
@@ -252,6 +254,7 @@ public class ForeignFunctions {
                 case "R_externalptr_prototype_object":
                 case "R_getGeneric":
                 case "R_get_slot":
+                    return R_getSlotNodeGen.create();
                 case "R_hasSlot":
                 case "R_identC":
                     return R_identCNodeGen.create();
@@ -263,6 +266,7 @@ public class ForeignFunctions {
                 case "R_selectMethod":
                 case "R_set_el_named":
                 case "R_set_slot":
+                    return R_setSlotNodeGen.create();
                 case "R_standardGeneric":
                 case "do_substitute_direct":
                 case "Rf_allocS4Object":

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java

@@ -41,10 +41,13 @@ public class TestS4 extends TestBase {
         assertEval(Output.ContainsError, "{ getClass(\"ClassUnionRepresentation\")@foo }");
         assertEval(Output.ContainsError, "{ c(42)@foo }");
         assertEval(Output.ContainsError, "{ x<-c(42); class(x)<-\"bar\"; x@foo }");
+        assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, \"virtual\") }");
+        assertEval(Output.ContainsError, "{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, virtual) }");
     }
 
     @Test
     public void testSlotUpdate() {
         assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); x@virtual<-TRUE; x@virtual }");
+        assertEval("{ x<-getClass(\"ClassUnionRepresentation\"); slot(x, \"virtual\", check=TRUE)<-TRUE; x@virtual }");
     }
 }