[GR-2798] Fix SET_ATTRIB and fast-path for stopifnot.

PullRequest: fastr/2060

Author: steve-s

.gitignore

@@ -157,3 +157,5 @@ lib.install.packages.fastr
 lib.install.packages.gnur
 /com.oracle.truffle.r.release/doc/
 .Rproj.user
+com.oracle.truffle.r.test.native/packages/*/*/src/*.so
+com.oracle.truffle.r.test.native/packages/*/*/src/*.o

com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/AttributesAccessNodes.java

@@ -32,6 +32,7 @@
 import com.oracle.truffle.api.dsl.Fallback;
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.api.library.CachedLibrary;
+import com.oracle.truffle.api.object.DynamicObject;
 import com.oracle.truffle.api.profiles.ConditionProfile;
 import com.oracle.truffle.r.ffi.impl.nodes.AttributesAccessNodesFactory.ATTRIBNodeGen;
 import com.oracle.truffle.r.ffi.impl.nodes.AttributesAccessNodesFactory.CopyMostAttribNodeGen;
@@ -43,7 +44,9 @@
 import com.oracle.truffle.r.nodes.attributes.GetAttributesNode;
 import com.oracle.truffle.r.nodes.attributes.RemoveAttributeNode;
 import com.oracle.truffle.r.nodes.attributes.SetAttributeNode;
+import com.oracle.truffle.r.nodes.attributes.SetPropertyNode;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetRowNamesAttributeNode;
+import com.oracle.truffle.r.nodes.function.opt.ShareObjectNode;
 import com.oracle.truffle.r.nodes.function.opt.UpdateShareableChildValueNode;
 import com.oracle.truffle.r.nodes.unary.CastNode;
 import com.oracle.truffle.r.nodes.unary.InternStringNode;
@@ -269,7 +272,9 @@ public static CopyMostAttrib create() {
 
     /**
      * Overrides the attributes pairlist of given object with a new pairlist. In FastR, we have to
-     * convert the pairlist to our representation.
+     * convert the pairlist to our representation. This doesn't do any validation in GNU-R and
+     * simply sets the attributes pairlist to given value and some packages assume that they can,
+     * e.g., fixup any inconsistencies in special attributes like dims afterwards.
      */
     public abstract static class SetAttribNode extends FFIUpCallNode.Arg2 {
 
@@ -279,9 +284,11 @@ public static SetAttribNode create() {
 
         @Specialization
         protected Object doIt(RSharingAttributeStorage target, RPairList attributes,
-                        @Cached("create()") SetAttributeNode setAttribNode,
+                        @Cached SetPropertyNode setPropertyNode,
+                        @Cached ShareObjectNode shareObjectNode,
                         @CachedLibrary(limit = "1") RPairListLibrary plLib) {
             clearAttrs(target);
+            DynamicObject attrs = target.getAttributes();
             for (RPairList attr : attributes) {
                 Object tag = plLib.getTag(attr);
                 if (!(tag instanceof RSymbol)) {
@@ -291,7 +298,9 @@ protected Object doIt(RSharingAttributeStorage target, RPairList attributes,
                     RError.warning(NO_CALLER, Message.NO_TAG_IN_SET_ATTRIB, Utils.getTypeName(tag));
                     continue;
                 }
-                setAttribNode.execute(target, ((RSymbol) tag).getName(), plLib.car(attr));
+                Object value = plLib.car(attr);
+                shareObjectNode.execute(value);
+                setPropertyNode.execute(attrs, ((RSymbol) tag).getName(), value);
             }
             return RNull.instance;
         }

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

@@ -46,8 +46,11 @@
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.GetFastPathNodeGen;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.IntersectFastPathNodeGen;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.IsElementFastPathNodeGen;
+import com.oracle.truffle.r.nodes.builtin.base.fastpaths.MatchArgFastPath;
+import com.oracle.truffle.r.nodes.builtin.base.fastpaths.MatchArgFastPathNodeGen;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.MatrixFastPathNodeGen;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.SetDiffFastPathNodeGen;
+import com.oracle.truffle.r.nodes.builtin.base.fastpaths.StopifnotFastPath;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.SubscriptDataFrameFastPathNodeGen;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.SubsetDataFrameFastPath;
 import com.oracle.truffle.r.nodes.builtin.base.fastpaths.SubsetDataFrameFastPathNodeGen;
@@ -917,6 +920,7 @@ public void loadOverrides(MaterializedFrame baseFrame) {
         addFastPath(baseFrame, "seq.default", SeqFunctionsFactory.SeqDefaultFastPathNodeGen::create, RVisibility.ON);
         addFastPath(baseFrame, "seq", SeqFunctionsFactory.SeqFastPathNodeGen::create, RVisibility.ON);
         addFastPath(baseFrame, "match.arg", MatchArgFastPathNodeGen::create, MatchArgFastPath.class);
+        addFastPath(baseFrame, "stopifnot", StopifnotFastPath::new, StopifnotFastPath.class);
 
         setContainsDispatch(baseFrame, "eval", "[.data.frame", "[[.data.frame", "[<-.data.frame", "[[<-.data.frame");
     }

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

@@ -78,7 +78,7 @@
 @RBuiltin(name = "identical", kind = INTERNAL, parameterNames = {"x", "y", "num.eq", "single.NA", "attrib.as.set", "ignore.bytecode", "ignore.environment", "ignore.srcref"}, behavior = PURE)
 public abstract class Identical extends RBuiltinNode.Arg8 {
 
-    protected abstract byte executeByte(Object x, Object y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref);
+    public abstract byte executeByte(Object x, Object y, boolean numEq, boolean singleNA, boolean attribAsSet, boolean ignoreBytecode, boolean ignoreEnvironment, boolean ignoreSrcref);
 
     @Child private Identical identicalRecursive;
     @Child private Identical identicalRecursiveAttr;

…nodes/builtin/base/MatchArgFastPath.java …tin/base/fastpaths/MatchArgFastPath.javacom.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/MatchArgFastPath.java renamed to com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/fastpaths/MatchArgFastPath.java com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/MatchArgFastPath.java renamed to com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/fastpaths/MatchArgFastPath.java

@@ -20,7 +20,7 @@
  * or visit www.oracle.com if you need additional information or have any
  * questions.
  */
-package com.oracle.truffle.r.nodes.builtin.base;
+package com.oracle.truffle.r.nodes.builtin.base.fastpaths;
 
 import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.logicalValue;
 import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.stringValue;
@@ -44,7 +44,12 @@
 import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.typeName;
 
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
-import com.oracle.truffle.r.nodes.builtin.base.MatchArgFastPathNodeGen.MatchArgInternalNodeGen;
+import com.oracle.truffle.r.nodes.builtin.base.AsCharacter;
+import com.oracle.truffle.r.nodes.builtin.base.AsCharacterNodeGen;
+import com.oracle.truffle.r.nodes.builtin.base.Identical;
+import com.oracle.truffle.r.nodes.builtin.base.IdenticalNodeGen;
+import com.oracle.truffle.r.nodes.builtin.base.PMatch;
+import com.oracle.truffle.r.nodes.builtin.base.PMatchNodeGen;
 import com.oracle.truffle.r.nodes.function.ClassHierarchyNode;
 import com.oracle.truffle.r.nodes.function.ClassHierarchyNodeGen;
 import com.oracle.truffle.r.nodes.function.FormalArguments;
@@ -288,7 +293,7 @@ public Object execute(VirtualFrame frame) {
     }
 
     protected static MatchArgInternal createInternal() {
-        return MatchArgInternalNodeGen.create();
+        return MatchArgFastPathNodeGen.MatchArgInternalNodeGen.create();
     }
 
     @Specialization(limit = "1", guards = "cache.choicesValue.isSupported(frame, arg)")
@@ -304,7 +309,7 @@ public static final class MatchArgNode extends Node {
 
         public MatchArgNode(VirtualFrame frame, RPromise arg) {
             this.choicesValue = new MatchArgChoices(frame, arg);
-            this.internal = MatchArgInternalNodeGen.create();
+            this.internal = MatchArgFastPathNodeGen.MatchArgInternalNodeGen.create();
             this.promiseHelper = new PromiseHelperNode();
         }
     }

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/fastpaths/StopifnotFastPath.java

@@ -0,0 +1,79 @@
+/*
+ * Copyright (c) 2019, 2019, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License version 3 only, as
+ * published by the Free Software Foundation.
+ *
+ * This code is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+ * version 3 for more details (a copy is included in the LICENSE file that
+ * accompanied this code).
+ *
+ * You should have received a copy of the GNU General Public License version
+ * 3 along with this work; if not, write to the Free Software Foundation,
+ * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+ *
+ * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+ * or visit www.oracle.com if you need additional information or have any
+ * questions.
+ */
+package com.oracle.truffle.r.nodes.builtin.base.fastpaths;
+
+import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
+import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.SUBSTITUTE;
+
+import com.oracle.truffle.api.frame.VirtualFrame;
+import com.oracle.truffle.api.profiles.ValueProfile;
+import com.oracle.truffle.r.nodes.binary.BoxPrimitiveNode;
+import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
+import com.oracle.truffle.r.runtime.RRuntime;
+import com.oracle.truffle.r.runtime.RVisibility;
+import com.oracle.truffle.r.runtime.builtins.RBuiltin;
+import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
+import com.oracle.truffle.r.runtime.data.RMissing;
+import com.oracle.truffle.r.runtime.data.RNull;
+import com.oracle.truffle.r.runtime.data.RPromise;
+import com.oracle.truffle.r.runtime.data.model.RAbstractLogicalVector;
+import com.oracle.truffle.r.runtime.nodes.RFastPathNode;
+
+/**
+ * {@code stopifnot} is often used to check some unlikely conditions. It is complex R function that
+ * always uses stack introspection and deparsing even if the condition evaluates to {@code TRUE},
+ * which is very expensive for "unlikely" condition check. This fast-path tries to avoid all this
+ * complexity for cases when the condition is single value that evaluates to {@code TRUE}.
+ */
+@RBuiltin(name = "stopifnot", kind = SUBSTITUTE, parameterNames = {"...", "exprs", "local"}, nonEvalArgs = {0, 1, 2}, behavior = COMPLEX, visibility = RVisibility.OFF)
+public class StopifnotFastPath extends RFastPathNode {
+    @Child private PromiseHelperNode promiseHelperNode = new PromiseHelperNode();
+    @Child private BoxPrimitiveNode boxPrimitiveNode = BoxPrimitiveNode.create();
+    private final ValueProfile resultProfile = ValueProfile.createClassProfile();
+
+    @Override
+    public Object execute(VirtualFrame frame, Object... args) {
+        if (!(args[0] instanceof RArgsValuesAndNames) || args[1] != RMissing.instance || args[2] != RMissing.instance) {
+            // Arguments "exprs" and "local" have default values
+            return null;
+        }
+        RArgsValuesAndNames dotdotdot = (RArgsValuesAndNames) args[0];
+        if (dotdotdot.getLength() != 1 || !(dotdotdot.getArgument(0) instanceof RPromise)) {
+            return null;
+        }
+        RPromise resultPromise = (RPromise) dotdotdot.getArgument(0);
+        Object result = resultProfile.profile(boxPrimitiveNode.execute(promiseHelperNode.evaluate(frame, resultPromise)));
+        if (!(result instanceof RAbstractLogicalVector)) {
+            // We fallback to the R code, the promise will be already evaluated and not re-evaluated
+            // Since the other arguments have only default values, there could not be any visible
+            // side effect between now and the point when the promise should have been really
+            // evaluated later in stopifnot R code
+            return null;
+        }
+        RAbstractLogicalVector resultVec = (RAbstractLogicalVector) result;
+        if (resultVec.getLength() != 1 || !RRuntime.fromLogical(resultVec.getDataAt(0))) {
+            return null;
+        }
+        return RNull.instance;
+    }
+}

com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/rapiTests.R

@@ -0,0 +1,52 @@
+# Copyright (c) 2019, Oracle and/or its affiliates. All rights reserved.
+# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+#
+# This code is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License version 3 only, as
+# published by the Free Software Foundation.
+#
+# This code is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# version 3 for more details (a copy is included in the LICENSE file that
+# accompanied this code).
+#
+# You should have received a copy of the GNU General Public License version
+# 3 along with this work; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+#
+# Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+# or visit www.oracle.com if you need additional information or have any
+# questions.
+
+# Contains unit-tests of the individual R API functions
+
+assertEquals <- function(expected, actual) {
+    width <- 80L
+    name <- substr(deparse(sys.call(), width)[[1L]], 1, width)
+    cat(name, paste(rep('.', width + 3L - nchar(name)), collapse=''))
+    cat(if (identical(expected, actual)) 'pass' else 'fail', '\n')
+}
+
+ignore <- function(...) {}
+
+library(testrffi)
+
+# ---------------------------------------------------------------------------------------
+# SET_ATTRIB
+
+x <- c(1,3,10)
+assertEquals(NULL, api.SET_ATTRIB(x, pairlist(names=c('a','b','q'))))
+assertEquals(c('a','b','q'), names(x))
+
+# there is no validation
+x <- c(1,3,10)
+assertEquals(NULL, api.SET_ATTRIB(x, as.pairlist(list(names=c('a','b')))))
+assertEquals(c('a','b'), names(x))
+# note: printing x on GNU-R causes segfault
+
+# ---------------------------------------------------------------------------------------
+# Rf_mkCharLenCE, note: last arg is encoding and 0 ~ native encoding
+
+assertEquals("hello world", api.Rf_mkCharLenCE("hello world", 11, 0))
+ignore("FastR bug", assertEquals("hello", api.Rf_mkCharLenCE("hello this will be cut away", 5, 0)))

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

@@ -0,0 +1,56 @@
+/*
+ * Copyright (c) 2019, 2019, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License version 3 only, as
+ * published by the Free Software Foundation.
+ *
+ * This code is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+ * version 3 for more details (a copy is included in the LICENSE file that
+ * accompanied this code).
+ *
+ * You should have received a copy of the GNU General Public License version
+ * 3 along with this work; if not, write to the Free Software Foundation,
+ * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+ *
+ * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+ * or visit www.oracle.com if you need additional information or have any
+ * questions.
+ */
+package com.oracle.truffle.r.test.builtins;
+
+import com.oracle.truffle.r.test.TestBase;
+import org.junit.Test;
+
+/**
+ * {@code stopifnot} is implemented in R code, but FastR has a fast-path replacement, which is
+ * tested here.
+ */
+public class TestBuiltin_stopifnot extends TestBase {
+    @Test
+    public void testStopifnotFastPathWithWarning() {
+        assertEval("{ foo <- function(a) { if (a != 42L) warning('my warning'); a }; stopifnot(foo(33) < 42) }");
+    }
+
+    @Test
+    public void testStopifnotFastPathBailoutWithSideEffect() {
+        assertEval("{ global <- 42; foo <- function() { if (global == 42) { global <<- 44; F } else T }; tryCatch(stopifnot(foo()), error=function(x) cat(x$message,'\\n')); global }");
+    }
+
+    @Test
+    public void testStopifnotFastPathConditionThrowsError() {
+        assertEval("{ foo <- function() { stop('my error') }; stopifnot(foo()) }");
+    }
+
+    @Test
+    public void testStopifnotBasicUsage() {
+        assertEval("stopifnot(4 < 5, 7 < 10, T)");
+        assertEval("stopifnot(4 < 5, 7 > 10, T)");
+        assertEval("stopifnot(exprs = { 4 < 5; 7 < 10; T })");
+        assertEval("stopifnot(exprs = { 4 < 5; 7 > 10; T })");
+        assertEval("stopifnot(1 == 1, all.equal(pi, 3.14159265), 1 < 2)");
+    }
+}