Honor classes "integer" and "double" in S3 dispatch.

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

@@ -27,7 +27,6 @@ import com.oracle.truffle.r.nodes.access.variables.LocalReadVariableNode;
 import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
 import com.oracle.truffle.r.nodes.function.CallMatcherNode;
 import com.oracle.truffle.r.nodes.function.ClassHierarchyNode;
-import com.oracle.truffle.r.nodes.function.ClassHierarchyNodeGen;
 import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
 import com.oracle.truffle.r.nodes.function.PromiseHelperNode.PromiseCheckHelperNode;
 import com.oracle.truffle.r.nodes.function.S3FunctionLookupNode;
@@ -96,7 +95,7 @@ public abstract class S3DispatchFunctions {
          * ignored and a warning is generated.
          */
 
-        @Child private ClassHierarchyNode classHierarchyNode = ClassHierarchyNodeGen.create(true, true);
+        @Child private ClassHierarchyNode classHierarchyNode = ClassHierarchyNode.createForDispatch(true);
         @Child private PromiseCheckHelperNode promiseCheckHelper;
         @Child private Helper helper = new Helper(false);
 
@@ -294,7 +293,7 @@ public abstract class S3DispatchFunctions {
             }
             if (hierarchy == null) {
                 CompilerDirectives.transferToInterpreterAndInvalidate();
-                hierarchy = insert(ClassHierarchyNode.createWithImplicit());
+                hierarchy = insert(ClassHierarchyNode.createForDispatch(false));
             }
             return hierarchy.execute(arg);
         }

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/AccessSlotNode.java

@@ -136,7 +136,7 @@ public abstract class AccessSlotNode extends RBaseNode {
                     @Cached("create()") GetClassAttributeNode getClassNode) {
         RStringVector classAttr = getClassNode.getClassAttr(object);
         if (classAttr == null) {
-            RStringVector implicitClassVec = ImplicitClassHierarchyNode.getImplicitClass(object);
+            RStringVector implicitClassVec = ImplicitClassHierarchyNode.getImplicitClass(object, false);
             assert implicitClassVec.getLength() > 0;
             throw RError.error(this, RError.Message.SLOT_BASIC_CLASS, name, implicitClassVec.getDataAt(0));
         } else {

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/ClassHierarchyNode.java

@@ -67,7 +67,7 @@ public abstract class ClassHierarchyNode extends UnaryNode {
         RStringVector result = null;
         if (value instanceof RAttributable) {
             Object v = ((RAttributable) value).getAttr(RRuntime.CLASS_ATTR_KEY);
-            result = v instanceof RStringVector ? (RStringVector) v : ImplicitClassHierarchyNode.getImplicitClass(value);
+            result = v instanceof RStringVector ? (RStringVector) v : ImplicitClassHierarchyNode.getImplicitClass(value, false);
         }
 
         return result != null ? result : RDataFactory.createEmptyStringVector();
@@ -95,13 +95,20 @@ public abstract class ClassHierarchyNode extends UnaryNode {
 
     private final boolean withImplicitTypes;
     private final boolean withS4;
+    private final boolean forDispatch;
     private final ConditionProfile noAttributesProfile = ConditionProfile.createBinaryProfile();
     private final ConditionProfile nullAttributeProfile = ConditionProfile.createBinaryProfile();
     private final ConditionProfile isS4Profile = ConditionProfile.createBinaryProfile();
 
-    protected ClassHierarchyNode(boolean withImplicitTypes, boolean withS4) {
+    protected ClassHierarchyNode(boolean withImplicitTypes, boolean withS4, boolean forDispatch) {
+        assert !forDispatch || withImplicitTypes : "forDispatch requires withImplicitTypes";
         this.withImplicitTypes = withImplicitTypes;
         this.withS4 = withS4;
+        this.forDispatch = forDispatch;
+    }
+
+    protected ClassHierarchyNode(boolean withImplicitTypes, boolean withS4) {
+        this(withImplicitTypes, withS4, false);
     }
 
     public static ClassHierarchyNode create() {
@@ -112,51 +119,60 @@ public abstract class ClassHierarchyNode extends UnaryNode {
         return ClassHierarchyNodeGen.create(true, false);
     }
 
+    /*
+     * Creates node that return result, which is meant to be used for S3 dispatch, in such case the
+     * "numeric" class will be preceeded by "integer" or "double" classes. This seems to be not used
+     * anywhere else than for the dispatch.
+     */
+    public static ClassHierarchyNode createForDispatch(boolean withS4) {
+        return ClassHierarchyNodeGen.create(true, withS4, true);
+    }
+
     public abstract RStringVector execute(Object arg);
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") byte arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Logical) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Logical, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") String arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Character) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Character, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") int arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Integer) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Integer, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") double arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Double) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Double, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") RComplex arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Complex) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Complex, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") RRaw arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Raw) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Raw, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") RNull arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Null) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Null, forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") RInteropScalar arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(arg.getRType()) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(arg.getRType(), forDispatch) : null;
     }
 
     @Specialization
     protected RStringVector getClassHr(@SuppressWarnings("unused") REmpty arg) {
-        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Null) : null;
+        return withImplicitTypes ? ImplicitClassHierarchyNode.getImplicitClass(RType.Null, forDispatch) : null;
     }
 
     @Specialization
@@ -194,7 +210,7 @@ public abstract class ClassHierarchyNode extends UnaryNode {
         if (withImplicitTypes) {
             if (implicit == null) {
                 CompilerDirectives.transferToInterpreterAndInvalidate();
-                implicit = insert(ImplicitClassHierarchyNodeGen.create());
+                implicit = insert(ImplicitClassHierarchyNodeGen.create(forDispatch));
             }
             return implicit.execute(arg);
         } else {

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/ImplicitClassHierarchyNode.java

@@ -43,9 +43,24 @@ public abstract class ImplicitClassHierarchyNode extends UnaryNode {
 
     private static final RStringVector implicitArrayClass = ShareObjectNode.sharePermanent(RDataFactory.createStringVector("array"));
     private static final RStringVector implicitMatrixClass = ShareObjectNode.sharePermanent(RDataFactory.createStringVector("matrix"));
+    private static final RStringVector dispatchDoubleImplicitClass = ShareObjectNode.sharePermanent(RDataFactory.createStringVector(new String[]{"double", "numeric"}, RDataFactory.COMPLETE_VECTOR));
+    private static final RStringVector dispatchIntegerImplicitClass = ShareObjectNode.sharePermanent(RDataFactory.createStringVector(new String[]{"integer", "numeric"}, RDataFactory.COMPLETE_VECTOR));
     @CompilationFinal(dimensions = 1) private static final RStringVector[] implicitClasses = new RStringVector[RType.values().length];
 
-    public static RStringVector getImplicitClass(RType type) {
+    private final boolean forDispatch;
+
+    protected ImplicitClassHierarchyNode(boolean forDispatch) {
+        this.forDispatch = forDispatch;
+    }
+
+    public static RStringVector getImplicitClass(RType type, boolean forDispatch) {
+        if (forDispatch) {
+            if (type == RType.Double) {
+                return dispatchDoubleImplicitClass;
+            } else if (type == RType.Integer) {
+                return dispatchIntegerImplicitClass;
+            }
+        }
         RStringVector result = implicitClasses[type.ordinal()];
         if (result == null) {
             CompilerDirectives.transferToInterpreterAndInvalidate();
@@ -57,27 +72,27 @@ public abstract class ImplicitClassHierarchyNode extends UnaryNode {
     public abstract RStringVector execute(Object arg);
 
     @Specialization
-    protected static RStringVector get(@SuppressWarnings("unused") int value) {
-        return getImplicitClass(RType.Integer);
+    protected RStringVector get(@SuppressWarnings("unused") int value) {
+        return getImplicitClass(RType.Integer, forDispatch);
     }
 
     @Specialization
-    protected static RStringVector get(@SuppressWarnings("unused") double value) {
-        return getImplicitClass(RType.Double);
+    protected RStringVector get(@SuppressWarnings("unused") double value) {
+        return getImplicitClass(RType.Double, forDispatch);
     }
 
     @Specialization
-    protected static RStringVector get(@SuppressWarnings("unused") String value) {
-        return getImplicitClass(RType.Character);
+    protected RStringVector get(@SuppressWarnings("unused") String value) {
+        return getImplicitClass(RType.Character, forDispatch);
     }
 
     @Specialization
-    protected static RStringVector get(@SuppressWarnings("unused") byte value) {
-        return getImplicitClass(RType.Logical);
+    protected RStringVector get(@SuppressWarnings("unused") byte value) {
+        return getImplicitClass(RType.Logical, forDispatch);
     }
 
     @Specialization(limit = "5", guards = "value.getClass() == valueClass")
-    protected static RStringVector getCachedClass(RTypedValue value,
+    protected RStringVector getCachedClass(RTypedValue value,
                     @Cached("value.getClass()") Class<? extends RTypedValue> valueClass,
                     @Cached("createBinaryProfile()") ConditionProfile isArray,
                     @Cached("createBinaryProfile()") ConditionProfile isMatrix,
@@ -86,7 +101,7 @@ public abstract class ImplicitClassHierarchyNode extends UnaryNode {
     }
 
     @Specialization(replaces = "getCachedClass", limit = "5", guards = "value.getRType() == type")
-    protected static RStringVector getCachedType(RTypedValue value,
+    protected RStringVector getCachedType(RTypedValue value,
                     @Cached("value.getRType()") RType type,
                     @Cached("createBinaryProfile()") ConditionProfile isArray,
                     @Cached("createBinaryProfile()") ConditionProfile isMatrix,
@@ -97,28 +112,28 @@ public abstract class ImplicitClassHierarchyNode extends UnaryNode {
         } else if (isArray.profile(GetDimAttributeNode.isArray(dimensions))) {
             return implicitArrayClass;
         } else {
-            return getImplicitClass(type);
+            return getImplicitClass(type, forDispatch);
         }
     }
 
     @Specialization(replaces = {"getCachedClass", "getCachedType"})
-    protected static RStringVector get(RTypedValue value,
+    protected RStringVector get(RTypedValue value,
                     @Cached("createBinaryProfile()") ConditionProfile isArray,
                     @Cached("createBinaryProfile()") ConditionProfile isMatrix,
                     @Cached("create()") GetDimAttributeNode getDim) {
         return getCachedType(value, value.getRType(), isArray, isMatrix, getDim);
     }
 
-    public static RStringVector getImplicitClass(Object value) {
+    public static RStringVector getImplicitClass(Object value, boolean forDispatch) {
         CompilerAsserts.neverPartOfCompilation();
         if (value instanceof Integer) {
-            return getImplicitClass(RType.Integer);
+            return getImplicitClass(RType.Integer, forDispatch);
         } else if (value instanceof Double) {
-            return getImplicitClass(RType.Double);
+            return getImplicitClass(RType.Double, forDispatch);
         } else if (value instanceof String) {
-            return getImplicitClass(RType.Character);
+            return getImplicitClass(RType.Character, forDispatch);
         } else if (value instanceof Byte) {
-            return getImplicitClass(RType.Logical);
+            return getImplicitClass(RType.Logical, forDispatch);
         } else if (value instanceof RAttributable) {
             RAttributable attributable = (RAttributable) value;
             RIntVector dim = (RIntVector) attributable.getAttr(RRuntime.DIM_ATTR_KEY);
@@ -131,6 +146,6 @@ public abstract class ImplicitClassHierarchyNode extends UnaryNode {
                 }
             }
         }
-        return getImplicitClass(((RTypedValue) value).getRType());
+        return getImplicitClass(((RTypedValue) value).getRType(), forDispatch);
     }
 }

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

@@ -77395,6 +77395,13 @@ $named$e
+##com.oracle.truffle.r.test.functions.TestS3Dispatch.runRSourceTests#
+#{ source("mxbuild/com.oracle.truffle.r.test/bin/com/oracle/truffle/r/test/functions/S3/R/numericTypes.R") }
+integer
+double
+logical
+default
+
 ##com.oracle.truffle.r.test.functions.TestS3Dispatch.testComplexGroupDispatch#
 #{x<--7+2i;class(x)<-"foo";Complex.foo<-function(z){1;};Im(x);}
 [1] 1

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/functions/S3/R/numericTypes.R

+# Copyright (c) 2013, 2016, 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.
+foo <- function(x) UseMethod('foo')
+foo.integer <- function(x) 'integer'
+foo.double <- function(x) 'double'
+foo.logical <- function(x) 'logical'
+foo.numeric <- function(x) 'numeric'
+foo.default <- function(x) 'default'
+cat(foo(1L), "\n")
+cat(foo(3.14), "\n")
+cat(foo(T), "\n")
+cat(foo(quote(a)), "\n")