[GR-2798] Implemented builtins 'comment' and 'comment<-'.

PullRequest: fastr/1239

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

@@ -288,6 +288,7 @@ public class BasePackage extends RBuiltinPackage {
         add(ColSums.class, ColSumsNodeGen::create);
         add(Combine.class, CombineNodeGen::create);
         add(CommandArgs.class, CommandArgsNodeGen::create);
+        add(Comment.class, CommentNodeGen::create);
         add(Complex.class, ComplexNodeGen::create);
         add(CompileFunctions.CompilePKGS.class, CompileFunctionsFactory.CompilePKGSNodeGen::create);
         add(CompileFunctions.EnableJIT.class, CompileFunctionsFactory.EnableJITNodeGen::create);
@@ -732,6 +733,7 @@ public class BasePackage extends RBuiltinPackage {
         add(UpdateAttr.class, UpdateAttrNodeGen::create);
         add(UpdateAttributes.class, UpdateAttributesNodeGen::create);
         add(UpdateClass.class, UpdateClassNodeGen::create);
+        add(UpdateComment.class, UpdateCommentNodeGen::create);
         add(UpdateDim.class, UpdateDimNodeGen::create);
         add(UpdateDimNames.class, UpdateDimNamesNodeGen::create);
         add(Utf8ToInt.class, Utf8ToIntNodeGen::create);

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

+/*
+ * Copyright (c) 2013, 2017, 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 2 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 2 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
+ * 2 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;
+
+import static com.oracle.truffle.r.runtime.RDispatch.INTERNAL_GENERIC;
+import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
+import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
+
+import com.oracle.truffle.api.dsl.Cached;
+import com.oracle.truffle.api.dsl.Specialization;
+import com.oracle.truffle.api.profiles.ConditionProfile;
+import com.oracle.truffle.r.nodes.attributes.GetFixedAttributeNode;
+import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
+import com.oracle.truffle.r.runtime.RRuntime;
+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;
+
+@RBuiltin(name = "comment", kind = INTERNAL, parameterNames = {"x"}, dispatch = INTERNAL_GENERIC, behavior = PURE)
+public abstract class Comment extends RBuiltinNode.Arg1 {
+
+    static {
+        Casts casts = new Casts(Comment.class);
+        casts.arg("x").mustNotBeMissing();
+    }
+
+    protected GetFixedAttributeNode createGetCommentAttrNode() {
+        return GetFixedAttributeNode.create(RRuntime.COMMENT_ATTR_KEY);
+    }
+
+    @Specialization
+    protected Object dim(RAbstractContainer container,
+                    @Cached("createBinaryProfile()") ConditionProfile hasCommentProfile,
+                    @Cached("createGetCommentAttrNode()") GetFixedAttributeNode getCommentAttrNode) {
+        Object commentAttr = getCommentAttrNode.execute(container);
+        if (hasCommentProfile.profile(commentAttr != null)) {
+            return commentAttr;
+        } else {
+            return RNull.instance;
+        }
+    }
+
+    @Specialization(guards = "!isRAbstractContainer(vector)")
+    protected RNull dim(@SuppressWarnings("unused") Object vector) {
+        return RNull.instance;
+    }
+}

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

+/*
+ * Copyright (c) 2013, 2017, 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 2 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 2 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
+ * 2 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;
+
+import static com.oracle.truffle.r.runtime.RDispatch.INTERNAL_GENERIC;
+import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
+import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
+
+import com.oracle.truffle.api.dsl.Cached;
+import com.oracle.truffle.api.dsl.Specialization;
+import com.oracle.truffle.r.nodes.attributes.RemoveFixedAttributeNode;
+import com.oracle.truffle.r.nodes.attributes.SetFixedAttributeNode;
+import com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef;
+import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
+import com.oracle.truffle.r.runtime.RRuntime;
+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.RAbstractStringVector;
+
+@RBuiltin(name = "comment<-", kind = INTERNAL, parameterNames = {"x", "value"}, dispatch = INTERNAL_GENERIC, behavior = PURE)
+public abstract class UpdateComment extends RBuiltinNode.Arg2 {
+
+    static {
+        Casts casts = new Casts(UpdateComment.class);
+        casts.arg("x").mustNotBeMissing();
+        casts.arg("value").mustNotBeMissing().mustBe(Predef.stringValue().or(Predef.nullValue()));
+    }
+
+    protected SetFixedAttributeNode createGetCommentAttrNode() {
+        return SetFixedAttributeNode.create(RRuntime.COMMENT_ATTR_KEY);
+    }
+
+    protected RemoveFixedAttributeNode createRemoveCommentAttrNode() {
+        return RemoveFixedAttributeNode.create(RRuntime.COMMENT_ATTR_KEY);
+    }
+
+    @Child private SetFixedAttributeNode setCommentAttrNode;
+
+    @Specialization
+    protected Object dim(RAbstractContainer container, RAbstractStringVector value) {
+        if (setCommentAttrNode == null) {
+            setCommentAttrNode = insert(createGetCommentAttrNode());
+        }
+        setCommentAttrNode.execute(container, value);
+        return container;
+    }
+
+    @Specialization
+    protected Object dim(RAbstractContainer container, @SuppressWarnings("unused") RNull value,
+                    @Cached("createRemoveCommentAttrNode()") RemoveFixedAttributeNode removeCommentNode) {
+        removeCommentNode.execute(container);
+        return container;
+    }
+
+    @SuppressWarnings("unused")
+    @Specialization(guards = "!isRAbstractContainer(vector)")
+    protected RNull dim(Object vector, Object value) {
+        return RNull.instance;
+    }
+}

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/printer/AttributesPrinter.java

@@ -73,7 +73,7 @@ final class AttributesPrinter implements ValuePrinter<RAttributable> {
                     continue;
                 }
             }
-            if (RRuntime.R_COMMENT.equals(a.getName()) || RRuntime.R_SOURCE.equals(a.getName()) ||
+            if (RRuntime.COMMENT_ATTR_KEY.equals(a.getName()) || RRuntime.R_SOURCE.equals(a.getName()) ||
                             RRuntime.R_SRCREF.equals(a.getName()) || RRuntime.R_WHOLE_SRCREF.equals(a.getName()) ||
                             RRuntime.R_SRCFILE.equals(a.getName())) {
                 continue;

com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RRuntime.java

@@ -174,7 +174,7 @@ public class RRuntime {
     public static final String R_LOAD_METHOD_NAME = "loadMethod";
     public static final String R_DOT_METHODS = ".Methods";
     public static final String R_SOURCE = "source";
-    public static final String R_COMMENT = "comment";
+    public static final String COMMENT_ATTR_KEY = "comment";
     public static final String R_SRCREF = "srcref";
     public static final String R_WHOLE_SRCREF = "wholeSrcref";
     public static final String R_SRCFILE = "srcfile";

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

@@ -15077,35 +15077,44 @@ numeric(0)
 [199,]  0  0  0  0  0
 [200,]  0  0  0  0  0
-##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment1#Ignored.Unimplemented#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment1#
 #argv <- list(NULL); .Internal(comment(argv[[1]]))
 NULL
-##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment2#Ignored.Unimplemented#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment2#
 #argv <- list(structure(list(c0 = structure(integer(0), .Label = character(0), class = 'factor')), .Names = 'c0', row.names = character(0), class = structure('integer(0)', .Names = 'c0'))); .Internal(comment(argv[[1]]))
 NULL
-##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment3#Ignored.Unimplemented#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment3#
 #argv <- list(structure(numeric(0), .Dim = c(0L, 0L))); .Internal(comment(argv[[1]]))
 NULL
-##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment4#Ignored.Unimplemented#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_comment.testcomment4#
 #argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998'))); .Internal(comment(argv[[1]]))
 [1] "This is my very important data from experiment #0234"
 [2] "Jun 5, 1998"
-##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign1#Ignored.ImplementationError#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testCommentAssign#
+#{ x <- matrix(1:12, 3, 4); comment(x) <- c('This is my very important data from experiment #0234', 'Jun 5, 1998'); print(x); comment(x) }
+     [,1] [,2] [,3] [,4]
+[1,]    1    4    7   10
+[2,]    2    5    8   11
+[3,]    3    6    9   12
+[1] "This is my very important data from experiment #0234"
+[2] "Jun 5, 1998"
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign1#
 #argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998')), c('This is my very important data from experiment #0234', 'Jun 5, 1998')); .Internal(`comment<-`(argv[[1]], argv[[2]]))
      [,1] [,2] [,3] [,4]
 [1,]    1    4    7   10
 [2,]    2    5    8   11
 [3,]    3    6    9   12
-##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign2#Ignored.ImplementationError#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign2#
 #argv <- list(character(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))
 character(0)
-##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign3#Ignored.ImplementationError#
+##com.oracle.truffle.r.test.builtins.TestBuiltin_commentassign.testcommentassign3#
 #argv <- list(logical(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))
 logical(0)

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

@@ -19,27 +19,21 @@ public class TestBuiltin_comment extends TestBase {
 
     @Test
     public void testcomment1() {
-        // FIXME RInternalError: not implemented: .Internal comment
-        assertEval(Ignored.Unimplemented, "argv <- list(NULL); .Internal(comment(argv[[1]]))");
+        assertEval("argv <- list(NULL); .Internal(comment(argv[[1]]))");
     }
 
     @Test
     public void testcomment2() {
-        // FIXME RInternalError: not implemented: .Internal comment
-        assertEval(Ignored.Unimplemented,
-                        "argv <- list(structure(list(c0 = structure(integer(0), .Label = character(0), class = 'factor')), .Names = 'c0', row.names = character(0), class = structure('integer(0)', .Names = 'c0'))); .Internal(comment(argv[[1]]))");
+        assertEval("argv <- list(structure(list(c0 = structure(integer(0), .Label = character(0), class = 'factor')), .Names = 'c0', row.names = character(0), class = structure('integer(0)', .Names = 'c0'))); .Internal(comment(argv[[1]]))");
     }
 
     @Test
     public void testcomment3() {
-        // FIXME RInternalError: not implemented: .Internal comment
-        assertEval(Ignored.Unimplemented, "argv <- list(structure(numeric(0), .Dim = c(0L, 0L))); .Internal(comment(argv[[1]]))");
+        assertEval("argv <- list(structure(numeric(0), .Dim = c(0L, 0L))); .Internal(comment(argv[[1]]))");
     }
 
     @Test
     public void testcomment4() {
-        // FIXME RInternalError: not implemented: .Internal comment
-        assertEval(Ignored.Unimplemented,
-                        "argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998'))); .Internal(comment(argv[[1]]))");
+        assertEval("argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998'))); .Internal(comment(argv[[1]]))");
     }
 }

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

@@ -19,20 +19,21 @@ public class TestBuiltin_commentassign extends TestBase {
 
     @Test
     public void testcommentassign1() {
-        // FIXME FastR output: Error: there is no .Internal function 'comment<-'
-        assertEval(Ignored.ImplementationError,
-                        "argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998')), c('This is my very important data from experiment #0234', 'Jun 5, 1998')); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
+        assertEval("argv <- list(structure(1:12, .Dim = 3:4, comment = c('This is my very important data from experiment #0234', 'Jun 5, 1998')), c('This is my very important data from experiment #0234', 'Jun 5, 1998')); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
     }
 
     @Test
     public void testcommentassign2() {
-        // FIXME FastR output: Error: there is no .Internal function 'comment<-'
-        assertEval(Ignored.ImplementationError, "argv <- list(character(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
+        assertEval("argv <- list(character(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
     }
 
     @Test
     public void testcommentassign3() {
-        // FIXME FastR output: Error: there is no .Internal function 'comment<-'
-        assertEval(Ignored.ImplementationError, "argv <- list(logical(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
+        assertEval("argv <- list(logical(0), NULL); .Internal(`comment<-`(argv[[1]], argv[[2]]))");
+    }
+
+    @Test
+    public void testCommentAssign() {
+        assertEval("{ x <- matrix(1:12, 3, 4); comment(x) <- c('This is my very important data from experiment #0234', 'Jun 5, 1998'); print(x); comment(x) }");
     }
 }