diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SetS4Object.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SetS4Object.java
index 552c317a2903d1f017404e1a35629a12bb6b1ea2..4371caeddfe9632d03e9da6cf3d3406bfa7f6d76 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SetS4Object.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SetS4Object.java
@@ -22,6 +22,7 @@
*/
package com.oracle.truffle.r.nodes.builtin.base;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.*;
import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
@@ -32,14 +33,11 @@ import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
import com.oracle.truffle.r.nodes.objects.AsS4;
import com.oracle.truffle.r.nodes.objects.AsS4NodeGen;
import com.oracle.truffle.r.runtime.RError;
-import com.oracle.truffle.r.runtime.RRuntime;
import com.oracle.truffle.r.runtime.builtins.RBuiltin;
import com.oracle.truffle.r.runtime.context.RContext;
import com.oracle.truffle.r.runtime.data.RAttributable;
import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RSequence;
-import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
-import com.oracle.truffle.r.runtime.data.model.RAbstractLogicalVector;
@RBuiltin(name = "setS4Object", kind = INTERNAL, parameterNames = {"object", "flag", "complete"}, behavior = PURE)
public abstract class SetS4Object extends RBuiltinNode {
@@ -48,25 +46,15 @@ public abstract class SetS4Object extends RBuiltinNode {
@Override
protected void createCasts(CastBuilder casts) {
- casts.toAttributable(0, true, true, true);
- casts.toLogical(1);
- casts.toInteger(2);
- }
-
- private boolean checkArgs(RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
- if (flagVec.getLength() == 0 || (flagVec.getLength() == 1 && flagVec.getDataAt(0) == RRuntime.LOGICAL_NA) || flagVec.getLength() > 1) {
- throw RError.error(this, RError.Message.INVALID_ARGUMENT, "flag");
- }
- if (completeVec.getLength() == 0 || flagVec.getDataAt(0) == RRuntime.LOGICAL_NA) {
- throw RError.error(this, RError.Message.INVALID_ARGUMENT, "complete");
- }
- return RRuntime.fromLogical(flagVec.getDataAt(0));
+ casts.arg("object").asAttributable(true, true, true);
+ casts.arg("flag").asLogicalVector().mustBe(singleElement(), RError.SHOW_CALLER, RError.Message.INVALID_ARGUMENT, "flag").findFirst().map(toBoolean());
+ // "complete" can be a vector, unlike "flag"
+ casts.arg("complete").asIntegerVector().findFirst(RError.SHOW_CALLER, RError.Message.INVALID_ARGUMENT, "complete");
}
@Specialization
@TruffleBoundary
- protected RNull asS4(RNull object, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
- boolean flag = checkArgs(flagVec, completeVec);
+ protected RNull asS4(RNull object, boolean flag, @SuppressWarnings("unused") int complete) {
if (flag) {
RContext.getInstance().setNullS4Object(true);
} else {
@@ -80,14 +68,13 @@ public abstract class SetS4Object extends RBuiltinNode {
}
@Specialization(guards = "!isSequence(object)")
- protected Object asS4(RAttributable object, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
- boolean flag = checkArgs(flagVec, completeVec);
- return asS4.executeObject(object, flag, completeVec.getDataAt(0));
+ protected Object asS4(RAttributable object, boolean flag, int complete) {
+ return asS4.executeObject(object, flag, complete);
}
@Specialization
- protected Object asS4(RSequence seq, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
- return asS4(seq.materialize(), flagVec, completeVec);
+ protected Object asS4(RSequence seq, boolean flag, int complete) {
+ return asS4(seq.materialize(), flag, complete);
}
protected boolean isSequence(Object o) {
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Slot.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Slot.java
index c916d144022f5e7e3d863cf937e31b466d3735bc..57dc5a43393f2e5352f159744dc7454830252ee1 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Slot.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Slot.java
@@ -39,7 +39,7 @@ public abstract class Slot extends RBuiltinNode {
@Override
protected void createCasts(CastBuilder casts) {
- casts.toAttributable(0, true, true, true);
+ casts.arg(0).asAttributable(true, true, true);
}
private String getName(Object nameObj) {
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/StandardGeneric.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/StandardGeneric.java
index 753985e79b18a00b1517e436a7c09c8ff6849cf5..48572c7a8c378fda8f7eefac49e9ef77660dab36 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/StandardGeneric.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/StandardGeneric.java
@@ -12,10 +12,13 @@
*/
package com.oracle.truffle.r.nodes.builtin.base;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.*;
import static com.oracle.truffle.r.runtime.RVisibility.CUSTOM;
import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.PRIMITIVE;
+import java.util.function.Function;
+
import com.oracle.truffle.api.CompilerDirectives;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.frame.MaterializedFrame;
@@ -28,6 +31,8 @@ import com.oracle.truffle.r.nodes.attributes.AttributeAccess;
import com.oracle.truffle.r.nodes.attributes.AttributeAccessNodeGen;
import com.oracle.truffle.r.nodes.builtin.CastBuilder;
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
+import com.oracle.truffle.r.nodes.function.ClassHierarchyScalarNode;
+import com.oracle.truffle.r.nodes.function.ClassHierarchyScalarNodeGen;
import com.oracle.truffle.r.nodes.objects.CollectGenericArgumentsNode;
import com.oracle.truffle.r.nodes.objects.CollectGenericArgumentsNodeGen;
import com.oracle.truffle.r.nodes.objects.DispatchGeneric;
@@ -39,15 +44,12 @@ import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RRuntime;
import com.oracle.truffle.r.runtime.builtins.RBuiltin;
import com.oracle.truffle.r.runtime.context.RContext;
-import com.oracle.truffle.r.runtime.data.RAttributable;
-import com.oracle.truffle.r.runtime.data.RAttributeProfiles;
import com.oracle.truffle.r.runtime.data.RAttributes;
import com.oracle.truffle.r.runtime.data.RFunction;
import com.oracle.truffle.r.runtime.data.RList;
import com.oracle.truffle.r.runtime.data.RMissing;
import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RStringVector;
-import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector;
import com.oracle.truffle.r.runtime.env.REnvironment;
// transcribed from src/main/objects.c
@@ -63,6 +65,7 @@ public abstract class StandardGeneric extends RBuiltinNode {
@Child private LocalReadVariableNode readSigARgs = LocalReadVariableNode.create(RRuntime.DOT_SIG_ARGS, true);
@Child private CollectGenericArgumentsNode collectArgumentsNode;
@Child private DispatchGeneric dispatchGeneric = DispatchGenericNodeGen.create();
+ @Child private ClassHierarchyScalarNode classNode;
@Child private CastNode castIntScalar;
@Child private CastNode castStringScalar;
@@ -77,10 +80,22 @@ public abstract class StandardGeneric extends RBuiltinNode {
private final BranchProfile noGenFunFound = BranchProfile.create();
private final ConditionProfile sameNamesProfile = ConditionProfile.createBinaryProfile();
- private final RAttributeProfiles attrProfiles = RAttributeProfiles.create();
+ private String argClass(Object arg) {
+ if (classNode == null) {
+ classNode = insert(ClassHierarchyScalarNodeGen.create());
+ }
+ return classNode.executeString(arg);
+ }
+
+ @Override
+ protected void createCasts(CastBuilder casts) {
+ casts.arg("f").defaultError(RError.Message.GENERIC, "argument to 'standardGeneric' must be a non-empty character string").mustBe(
+ stringValue()).asStringVector().findFirst().mustBe(lengthGt(0));
+ Function<Object, Object> argClass = this::argClass;
+ casts.arg("fdef").asAttributable(true, true, true).mustBe(missingValue().or(instanceOf(RFunction.class)), RError.SHOW_CALLER, RError.Message.EXPECTED_GENERIC, argClass);
+ }
- private Object stdGenericInternal(VirtualFrame frame, RAbstractStringVector fVec, RFunction fdef) {
- String fname = fVec.getDataAt(0);
+ private Object stdGenericInternal(VirtualFrame frame, String fname, RFunction fdef) {
MaterializedFrame fnFrame = fdef.getEnclosingFrame();
REnvironment mtable = (REnvironment) readMTableFirst.execute(frame, fnFrame);
if (mtable == null) {
@@ -105,7 +120,7 @@ public abstract class StandardGeneric extends RBuiltinNode {
return ret;
}
- private Object getFunction(VirtualFrame frame, RAbstractStringVector fVec, String fname, Object fnObj) {
+ private Object getFunction(VirtualFrame frame, String fname, Object fnObj) {
if (fnObj == RNull.instance) {
noGenFunFound.enter();
return null;
@@ -128,7 +143,7 @@ public abstract class StandardGeneric extends RBuiltinNode {
}
String gen = (String) castStringScalar.execute(genObj);
if (sameNamesProfile.profile(gen == fname)) {
- return stdGenericInternal(frame, fVec, fn);
+ return stdGenericInternal(frame, fname, fn);
} else {
// in many cases == is good enough (and this will be the fastest path), but it's not
// always sufficient
@@ -136,21 +151,20 @@ public abstract class StandardGeneric extends RBuiltinNode {
noGenFunFound.enter();
return null;
}
- return stdGenericInternal(frame, fVec, fn);
+ return stdGenericInternal(frame, fname, fn);
}
}
- @Specialization(guards = "fVec.getLength() > 0")
- protected Object stdGeneric(VirtualFrame frame, RAbstractStringVector fVec, RFunction fdef) {
- return stdGenericInternal(frame, fVec, fdef);
+ @Specialization
+ protected Object stdGeneric(VirtualFrame frame, String fname, RFunction fdef) {
+ return stdGenericInternal(frame, fname, fdef);
}
- @Specialization(guards = "fVec.getLength() > 0")
- protected Object stdGeneric(VirtualFrame frame, RAbstractStringVector fVec, @SuppressWarnings("unused") RMissing fdef) {
- String fname = fVec.getDataAt(0);
+ @Specialization
+ protected Object stdGeneric(VirtualFrame frame, String fname, @SuppressWarnings("unused") RMissing fdef) {
int n = RArguments.getDepth(frame);
Object fnObj = RArguments.getFunction(frame);
- fnObj = getFunction(frame, fVec, fname, fnObj);
+ fnObj = getFunction(frame, fname, fnObj);
if (fnObj != null) {
return fnObj;
}
@@ -161,10 +175,10 @@ public abstract class StandardGeneric extends RBuiltinNode {
}
// TODO: GNU R counts to (i < n) - does their equivalent of getDepth return a different
// value
- // TODO; shouldn't we count from n to 0?
+ // TODO: shouldn't we count from n to 0?
for (int i = 0; i <= n; i++) {
fnObj = sysFunction.executeObject(frame, i);
- fnObj = getFunction(frame, fVec, fname, fnObj);
+ fnObj = getFunction(frame, fname, fnObj);
if (fnObj != null) {
return fnObj;
}
@@ -172,14 +186,4 @@ public abstract class StandardGeneric extends RBuiltinNode {
throw RError.error(this, RError.Message.STD_GENERIC_WRONG_CALL, fname);
}
- @Specialization
- protected Object stdGeneric(Object fVec, RAttributable fdef) {
- if (!(fVec instanceof String || (fVec instanceof RAbstractStringVector && ((RAbstractStringVector) fVec).getLength() > 0))) {
- throw RError.error(this, RError.Message.GENERIC, "argument to 'standardGeneric' must be a non-empty character string");
- } else {
- RStringVector cl = fdef.getClassAttr(attrProfiles);
- // not a GNU R error message
- throw RError.error(this, RError.Message.EXPECTED_GENERIC, cl.getLength() == 0 ? RRuntime.STRING_NA : cl.getDataAt(0));
- }
- }
}
diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/CastToAttributableNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/CastToAttributableNode.java
index 769ee3d5558aa4b64476b6a7476e3e90c4c7d0a5..92608cf7e342cce9085cf9b329b841ccb42fd2e3 100644
--- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/CastToAttributableNode.java
+++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/unary/CastToAttributableNode.java
@@ -26,6 +26,7 @@ import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.r.runtime.RType;
import com.oracle.truffle.r.runtime.data.RAttributable;
import com.oracle.truffle.r.runtime.data.RFunction;
+import com.oracle.truffle.r.runtime.data.RMissing;
import com.oracle.truffle.r.runtime.data.RNull;
import com.oracle.truffle.r.runtime.data.RS4Object;
import com.oracle.truffle.r.runtime.data.RSymbol;
@@ -51,6 +52,12 @@ public abstract class CastToAttributableNode extends CastBaseNode {
return RNull.instance;
}
+ @Specialization
+ @SuppressWarnings("unused")
+ protected RMissing cast(RMissing rmissing) {
+ return RMissing.instance;
+ }
+
@Specialization
protected RAttributable cast(RAbstractContainer container) {
return container;
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index 6428634d5fcb7f20fc4d17888b6da5653f4d304e..de4609f72d21751ab2a827dde1c41e9b106880fb 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
@@ -374,6 +374,29 @@ Error in y@foo <- 42 : object 'y' not found
##com.oracle.truffle.r.test.S4.TestS4.testSlotUpdate
#{ x<-initialize@valueClass; initialize@valueClass<-"foo"; initialize@valueClass<-x }
+##com.oracle.truffle.r.test.S4.TestS4.testStdGeneric
+#{ standardGeneric("") }
+Error in standardGeneric("") :
+ argument to 'standardGeneric' must be a non-empty character string
+
+##com.oracle.truffle.r.test.S4.TestS4.testStdGeneric
+#{ standardGeneric("foo", 42) }
+Error: expected a generic function or a primitive for dispatch, got an object of class "numeric"
+
+##com.oracle.truffle.r.test.S4.TestS4.testStdGeneric
+#{ standardGeneric(42) }
+Error in standardGeneric(42) :
+ argument to 'standardGeneric' must be a non-empty character string
+
+##com.oracle.truffle.r.test.S4.TestS4.testStdGeneric
+#{ standardGeneric(character()) }
+Error in standardGeneric(character()) :
+ argument to 'standardGeneric' must be a non-empty character string
+
+##com.oracle.truffle.r.test.S4.TestS4.testStdGeneric
+#{ x<-42; class(x)<-character(); standardGeneric("foo", x) }
+Error: expected a generic function or a primitive for dispatch, got an object of class "numeric"
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_Arg.testArg1
#argv <- list(1+2i);Arg(argv[[1]]);
[1] 1.107149
@@ -43882,6 +43905,30 @@ Error: unexpected string constant in "argv <- list(''', '"
##com.oracle.truffle.r.test.builtins.TestBuiltin_setHook.testsetHook1
#argv <- structure(list(hookName = 'UserHook::stats4::onUnload', value = function(pkgname, ...) cat('onUnload', sQuote(pkgname), 'B', '\n')), .Names = c('hookName', 'value'));do.call('setHook', argv)
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, "TRUE") }
+[1] 42
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, TRUE, "1") }
+[1] 42
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, TRUE, c(1,2)) }
+[1] 42
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, TRUE, logical()) }
+Error in asS4(x, TRUE, logical()) : invalid 'complete' argument
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, c(TRUE, FALSE)) }
+Error in asS4(x, c(TRUE, FALSE)) : invalid 'flag' argument
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testSetS4Object
+#{ x<-42; asS4(x, logical()) }
+Error in asS4(x, logical()) : invalid 'flag' argument
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_setS4Object.testsetS4Object1
#argv <- list(structure('ObjectsWithPackage', class = structure('signature', package = 'methods'), .Names = '.Object', package = 'methods'), TRUE, 0L); .Internal(setS4Object(argv[[1]], argv[[2]], argv[[3]]))
An object of class “signatureâ€
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java
index d903558850aaac15c22318a819ca6b86323b9df3..41a29e7c30c60c0d76f902975ed2a4fa92aba4e6 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/TestS4.java
@@ -112,6 +112,15 @@ public class TestS4 extends TestRBase {
}
+ @Test
+ public void testStdGeneric() {
+ assertEval("{ standardGeneric(42) }");
+ assertEval("{ standardGeneric(character()) }");
+ assertEval("{ standardGeneric(\"\") }");
+ assertEval("{ standardGeneric(\"foo\", 42) }");
+ assertEval("{ x<-42; class(x)<-character(); standardGeneric(\"foo\", x) }");
+ }
+
@Override
public String getTestDir() {
return "S4";
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_setS4Object.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_setS4Object.java
index c3eaee2491f0e1c9a895d9849424fa2c695c276a..eeb9eae3cee9a745ea131db97efcf185b99ab545 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_setS4Object.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_setS4Object.java
@@ -99,4 +99,15 @@ public class TestBuiltin_setS4Object extends TestBase {
assertEval(Ignored.Unknown,
"argv <- list(structure(function (x, y, ...) UseMethod('plot'), target = structure(character(0), .Names = character(0), package = character(0), class = structure('signature', package = 'methods')), defined = structure(character(0), .Names = character(0), package = character(0), class = structure('signature', package = 'methods')), generic = character(0), class = structure('derivedDefaultMethod', package = 'methods')), TRUE, 0L); .Internal(setS4Object(argv[[1]], argv[[2]], argv[[3]]))");
}
+
+ @Test
+ public void testSetS4Object() {
+ assertEval("{ x<-42; asS4(x, \"TRUE\") }");
+ assertEval("{ x<-42; asS4(x, logical()) }");
+ assertEval("{ x<-42; asS4(x, c(TRUE, FALSE)) }");
+ assertEval("{ x<-42; asS4(x, TRUE, \"1\") }");
+ assertEval("{ x<-42; asS4(x, TRUE, logical()) }");
+ assertEval("{ x<-42; asS4(x, TRUE, c(1,2)) }");
+ }
+
}