UpdateLength and UpdateSlot: converted to cast pipelines

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

@@ -22,47 +22,47 @@
  */
 package com.oracle.truffle.r.nodes.builtin.base;
 
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.abstractVectorValue;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.doubleValue;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.integerValue;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.nullValue;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.singleElement;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.stringValue;
 import static com.oracle.truffle.r.runtime.RDispatch.INTERNAL_GENERIC;
+import static com.oracle.truffle.r.runtime.RError.Message.INVALID_UNNAMED_ARGUMENT;
+import static com.oracle.truffle.r.runtime.RError.Message.INVALID_UNNAMED_VALUE;
 import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
 import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.PRIMITIVE;
 
-import com.oracle.truffle.api.CompilerDirectives;
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.r.nodes.builtin.CastBuilder;
 import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
-import com.oracle.truffle.r.runtime.RError;
 import com.oracle.truffle.r.runtime.builtins.RBuiltin;
 import com.oracle.truffle.r.runtime.data.RNull;
 import com.oracle.truffle.r.runtime.data.model.RAbstractContainer;
-import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
 
 @RBuiltin(name = "length<-", kind = PRIMITIVE, parameterNames = {"x", "value"}, dispatch = INTERNAL_GENERIC, behavior = PURE)
 public abstract class UpdateLength extends RBuiltinNode {
 
     @Override
     protected void createCasts(CastBuilder casts) {
-        casts.toInteger(1, true, false, false);
+        // Note: `length<-`(NULL, newLen) really works in GnuR unlike other update builtins
+        // @formatter:off
+        casts.arg("x").mustBe(abstractVectorValue().or(nullValue()), this, INVALID_UNNAMED_ARGUMENT);
+        casts.arg("value").defaultError(this, INVALID_UNNAMED_VALUE).mustBe(nullValue().not()).
+                mustBe(integerValue().or(doubleValue()).or(stringValue())).
+                asIntegerVector().mustBe(singleElement()).findFirst();
+        // @formatter:on
     }
 
     @SuppressWarnings("unused")
-    @Specialization(guards = "isLengthOne(lengthVector)")
-    protected RNull updateLength(RNull value, RAbstractIntVector lengthVector) {
+    @Specialization
+    protected RNull updateLength(RNull value, int length) {
         return RNull.instance;
     }
 
-    @Specialization(guards = "isLengthOne(lengthVector)")
-    protected RAbstractContainer updateLength(RAbstractContainer container, RAbstractIntVector lengthVector) {
-        return container.resize(lengthVector.getDataAt(0));
-    }
-
-    @SuppressWarnings("unused")
     @Specialization
-    protected Object updateLengthError(Object vector, Object lengthVector) {
-        CompilerDirectives.transferToInterpreter();
-        throw RError.error(this, RError.Message.INVALID_UNNAMED_VALUE);
-    }
-
-    protected static boolean isLengthOne(RAbstractIntVector length) {
-        return length.getLength() == 1;
+    protected RAbstractContainer updateLength(RAbstractContainer container, int length) {
+        return container.resize(length);
     }
 }

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

@@ -58,7 +58,7 @@ public abstract class UpdateSlot extends RBuiltinNode {
 
     @Override
     protected void createCasts(CastBuilder casts) {
-        casts.toAttributable(0, true, true, true);
+        casts.arg(0, "").asAttributable(true, true, true);
     }
 
     protected String getName(Object nameObj) {

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

@@ -25931,6 +25931,22 @@ Error: unexpected symbol in "argv <- list(list('Residuals vs Fitted', 'Normal Q-
 #argv <- list(c(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE));length(argv[[1]]);
 [1] 260
+##com.oracle.truffle.r.test.builtins.TestBuiltin_lengthassign.testArgsCasts
+#{ x<-c(42, 1); length(x)<-'3'; x }
+[1] 42  1 NA
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_lengthassign.testArgsCasts
+#{ x<-c(42, 1); length(x)<-3.1; x }
+[1] 42  1 NA
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_lengthassign.testArgsCasts
+#{ x<-c(42, 1); length(x)<-c(1,2) }
+Error in length(x) <- c(1, 2) : invalid value
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_lengthassign.testArgsCasts
+#{ x<-quote(a); length(x)<-2 }
+Error in length(x) <- 2 : invalid argument
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_lengthassign.testLengthUpdate
 #{ x <- 1 ; f <- function() { length(x) <<- 2 } ; f() ; x }
 [1]  1 NA

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_lengthassign.java

@@ -67,4 +67,12 @@ public class TestBuiltin_lengthassign extends TestBase {
         assertEval("{ x<-c(a=7, b=42); length(x)<-1; x }");
         assertEval("{ x<-NULL; length(x)<-2; x }");
     }
+
+    @Test
+    public void testArgsCasts() {
+        assertEval("{ x<-quote(a); length(x)<-2 }");
+        assertEval("{ x<-c(42, 1); length(x)<-'3'; x }");
+        assertEval("{ x<-c(42, 1); length(x)<-3.1; x }");
+        assertEval("{ x<-c(42, 1); length(x)<-c(1,2) }");
+    }
 }