diff --git a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/RCallNode.java b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/RCallNode.java index b44c463f465a08c5b3f99e4c3a0fa5af461edfaf..f5dd065e6ff5665063a7f9385fe3444276844e73 100644 --- a/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/RCallNode.java +++ b/com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/function/RCallNode.java @@ -434,17 +434,34 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS Object dispatchObject = promiseHelperNode.checkEvaluate(frame, args[typeXIdx]); + boolean isS4Dispatch = false; + + // CHECK FOR S4 DISPATCH + // First, check S4 dispatch for 'dispatchObject' (= first suitable argument) if (isAttributableProfile.profile(dispatchObject instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) dispatchObject).isS4())) { + isS4Dispatch = true; + } else if (args.length > typeXIdx + 1 && dispatch == RDispatch.OPS_GROUP_GENERIC) { + for (int i = typeXIdx + 1; i < args.length; i++) { + Object argi = promiseHelperNode.checkEvaluate(frame, args[i]); + if (isAttributableProfile.profile(argi instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) argi).isS4())) { + isS4Dispatch = true; + break; + } + } + } + + if (isS4Dispatch) { RList list = (RList) promiseHelperNode.checkEvaluate(frame, REnvironment.getRegisteredNamespace("methods").get(".BasicFunsList")); int index = list.getElementIndexByName(builtin.getName()); if (index != -1) { RFunction basicFun = (RFunction) list.getDataAt(index); - Object result = call.execute(frame, basicFun, new RArgsValuesAndNames(args, argsSignature), null, null); - if (result != RRuntime.DEFERRED_DEFAULT_MARKER) { - return result; + Object res = call.execute(frame, basicFun, new RArgsValuesAndNames(args, argsSignature), null, null); + if (res != RRuntime.DEFERRED_DEFAULT_MARKER) { + return res; } } } + RStringVector typeX = classHierarchyNodeX.execute(dispatchObject); Result resultX = null; if (implicitTypeProfileX.profile(typeX != null)) { @@ -526,6 +543,36 @@ public abstract class RCallNode extends RCallBaseNode implements RSyntaxNode, RS return call.execute(frame, resultFunction, new RArgsValuesAndNames(args, argsSignature), s3Args, s3DefaulArguments); } + private static Object tryS4Dispatch(VirtualFrame frame, ConditionProfile isAttributableProfile, ConditionProfile isS4Profile, PromiseCheckHelperNode promiseHelperNode, FunctionDispatch call, + Object[] args, int typeXIdx, ArgumentsSignature argsSignature, RBuiltinDescriptor builtin, Object dispatchObject) { + + boolean isS4Dispatch = false; + + // First, check S4 dispatch for 'dispatchObject' (= first suitable argument) + if (isAttributableProfile.profile(dispatchObject instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) dispatchObject).isS4())) { + isS4Dispatch = true; + } else if (args.length > typeXIdx + 1) { + for (int i = typeXIdx + 1; i < args.length; i++) { + Object argi = promiseHelperNode.checkEvaluate(frame, args[i]); + if (isAttributableProfile.profile(argi instanceof RAttributeStorage) && isS4Profile.profile(((RAttributeStorage) argi).isS4())) { + isS4Dispatch = true; + break; + } + } + } + + if (isS4Dispatch) { + RList list = (RList) promiseHelperNode.checkEvaluate(frame, REnvironment.getRegisteredNamespace("methods").get(".BasicFunsList")); + int index = list.getElementIndexByName(builtin.getName()); + if (index != -1) { + RFunction basicFun = (RFunction) list.getDataAt(index); + return call.execute(frame, basicFun, new RArgsValuesAndNames(args, argsSignature), null, null); + } + } + + return null; + } + protected final class ForeignCall extends Node { @Child private CallArgumentsNode arguments; 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 1a9ebda52122b1ff9da0aeb76516d5745e6eaba9..02140bc48ad0656837f20a4b0fdff81bdbb4ca94 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 @@ -310,6 +310,9 @@ Creating a generic function from function ‘foo.bar’ in the global environmen [1] "primitive, A, B" [1] "primitive, B, A" +##com.oracle.truffle.r.test.S4.TestS4.runRSourceTests# +#{ source("tmptest/S4/groupGenericS4Dispatch.R") } + ##com.oracle.truffle.r.test.S4.TestS4.runRSourceTests#Output.IgnoreErrorContext# #{ source("tmptest/S4/refClasses0.R") } Error : invalid assignment for reference class field ‘aa’, should be from class “integer†or a subclass (was class “characterâ€) @@ -5849,6 +5852,10 @@ a$b(c) #{ as.call(42) } Error in as.call(42) : invalid argument list +##com.oracle.truffle.r.test.builtins.TestBuiltin_ascall.testAsCall#Output.IgnoreWhitespace# +#{ cl <- quote(fun(3)); as.call(cl) } +fun(3) + ##com.oracle.truffle.r.test.builtins.TestBuiltin_ascall.testAsCall# #{ f <- function() 23 ; l <- list(f) ; cl <- as.call(l) ; eval(cl) } [1] 23 @@ -69335,6 +69342,9 @@ $`can write` [1] "yes" +##com.oracle.truffle.r.test.builtins.TestBuiltin_svd.testSvd# +# + ##com.oracle.truffle.r.test.builtins.TestBuiltin_sweep.testSweep# #{ A <- matrix(1:15, ncol=5); sweep(A, 2, colSums(A), "/") } [,1] [,2] [,3] [,4] [,5] diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/groupGenericS4Dispatch.R b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/groupGenericS4Dispatch.R new file mode 100644 index 0000000000000000000000000000000000000000..4d972b633c32067a7fb9261095a309f68036c114 --- /dev/null +++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/S4/R/groupGenericS4Dispatch.R @@ -0,0 +1,7 @@ +setClass("Foo1234", slots = c(a = "numeric")) +setMethod("%*%", signature(x = "ANY", y = "Foo1234"), function(x, y) { "s4 dispatched" }) + +obj <- new("Foo1234") +x <- matrix(1.1:16.1, 4, 4) +obj@a <- runif(10) +x %*% obj