Skip to content

Commit a0b7a47

Browse files
committed
[GR-12069] Implement eapply builtin.
PullRequest: fastr/1755
2 parents 9d71429 + e9b5546 commit a0b7a47

File tree

7 files changed

+229
-1
lines changed

7 files changed

+229
-1
lines changed

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -414,6 +414,7 @@ public BasePackage() {
414414
add(DynLoadFunctions.GetSymbolInfo.class, DynLoadFunctionsFactory.GetSymbolInfoNodeGen::create);
415415
add(DynLoadFunctions.IsLoaded.class, DynLoadFunctionsFactory.IsLoadedNodeGen::create);
416416
add(VersionFunctions.ExtSoftVersion.class, VersionFunctionsFactory.ExtSoftVersionNodeGen::create);
417+
add(EApply.class, EApplyNodeGen::create);
417418
add(EncodeString.class, EncodeStringNodeGen::create);
418419
add(EncodingFunctions.Encoding.class, EncodingFunctionsFactory.EncodingNodeGen::create);
419420
add(EncodingFunctions.SetEncoding.class, EncodingFunctionsFactory.SetEncodingNodeGen::create);
Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
/*
2+
* Copyright (c) 2018, Oracle and/or its affiliates. All rights reserved.
3+
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4+
*
5+
* This code is free software; you can redistribute it and/or modify it
6+
* under the terms of the GNU General Public License version 3 only, as
7+
* published by the Free Software Foundation.
8+
*
9+
* This code is distributed in the hope that it will be useful, but WITHOUT
10+
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
11+
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12+
* version 3 for more details (a copy is included in the LICENSE file that
13+
* accompanied this code).
14+
*
15+
* You should have received a copy of the GNU General Public License version
16+
* 3 along with this work; if not, write to the Free Software Foundation,
17+
* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
18+
*
19+
* Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
20+
* or visit www.oracle.com if you need additional information or have any
21+
* questions.
22+
*/
23+
package com.oracle.truffle.r.nodes.builtin.base;
24+
25+
import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.instanceOf;
26+
import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
27+
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
28+
import com.oracle.truffle.api.dsl.Cached;
29+
import com.oracle.truffle.api.dsl.Specialization;
30+
import com.oracle.truffle.api.frame.VirtualFrame;
31+
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.ExtractNamesAttributeNode;
32+
import com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef;
33+
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
34+
import com.oracle.truffle.r.nodes.builtin.base.EnvFunctions.EnvToList;
35+
import com.oracle.truffle.r.nodes.builtin.base.Lapply.LapplyInternalNode;
36+
import com.oracle.truffle.r.nodes.builtin.base.LapplyNodeGen.LapplyInternalNodeGen;
37+
import com.oracle.truffle.r.runtime.RError;
38+
import com.oracle.truffle.r.runtime.RError.Message;
39+
import com.oracle.truffle.r.runtime.RRuntime;
40+
import com.oracle.truffle.r.runtime.builtins.RBuiltin;
41+
import com.oracle.truffle.r.runtime.data.RFunction;
42+
import com.oracle.truffle.r.runtime.data.RDataFactory.VectorFactory;
43+
import com.oracle.truffle.r.runtime.data.RStringVector;
44+
import com.oracle.truffle.r.runtime.env.REnvironment;
45+
46+
@RBuiltin(name = "eapply", kind = INTERNAL, parameterNames = {"env", "FUN", "all.names", "USE.NAMES"}, splitCaller = true, behavior = COMPLEX)
47+
public abstract class EApply extends RBuiltinNode.Arg4 {
48+
49+
@Child private LapplyInternalNode eapply = LapplyInternalNodeGen.create();
50+
51+
static {
52+
Casts casts = new Casts(EApply.class);
53+
casts.arg("FUN").mustBe(instanceOf(RFunction.class), RError.Message.APPLY_NON_FUNCTION);
54+
casts.arg("env").mustNotBeNull(Message.USE_NULL_ENV_DEFUNCT).mustBe(REnvironment.class, Message.ARG_MUST_BE_ENV);
55+
casts.arg("all.names").asLogicalVector().findFirst().replaceNA(RRuntime.LOGICAL_FALSE).map(Predef.toBoolean());
56+
casts.arg("USE.NAMES").asLogicalVector().findFirst().replaceNA(RRuntime.LOGICAL_FALSE).map(Predef.toBoolean());
57+
}
58+
59+
@Specialization
60+
protected Object lapply(VirtualFrame frame, REnvironment env, RFunction fun, boolean allNames, boolean useNames,
61+
@Cached("create()") EnvToList envToList,
62+
@Cached("create()") ExtractNamesAttributeNode extractNamesNode,
63+
@Cached("create()") VectorFactory factory) {
64+
Object l = envToList.execute(frame, env, allNames, true);
65+
Object[] result = eapply.execute(frame, l, fun);
66+
67+
RStringVector names = null;
68+
if (useNames) {
69+
names = result.length == 0 ? factory.createEmptyStringVector() : extractNamesNode.execute(l);
70+
}
71+
return factory.createList(result, names);
72+
}
73+
74+
}

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@
5757
import com.oracle.truffle.r.nodes.builtin.EnvironmentNodes.RList2EnvNode;
5858
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
5959
import com.oracle.truffle.r.nodes.builtin.base.EnvFunctionsFactory.CopyNodeGen;
60+
import com.oracle.truffle.r.nodes.builtin.base.EnvFunctionsFactory.EnvToListNodeGen;
6061
import com.oracle.truffle.r.nodes.function.GetCallerFrameNode;
6162
import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
6263
import com.oracle.truffle.r.nodes.function.PromiseHelperNode.PromiseDeoptimizeFrameNode;
@@ -674,6 +675,10 @@ public abstract static class EnvToList extends RBuiltinNode.Arg3 {
674675
casts.arg("sorted").mustNotBeNull().asLogicalVector().findFirst(RRuntime.LOGICAL_FALSE).map(toBoolean());
675676
}
676677

678+
public static EnvToList create() {
679+
return EnvToListNodeGen.create();
680+
}
681+
677682
private Object copy(VirtualFrame frame, Object operand) {
678683
if (copy == null) {
679684
CompilerDirectives.transferToInterpreterAndInvalidate();

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -839,6 +839,9 @@ private DeparseVisitor appendArgs(ArgumentsSignature signature, RSyntaxElement[]
839839
} else {
840840
append(quotify(name, BACKTICK));
841841
}
842+
if ("...".equals(name) && argument instanceof RSyntaxLookup && "...".equals(((RSyntaxLookup) argument).getIdentifier())) {
843+
continue;
844+
}
842845
if (!formals || argument != null) {
843846
append(" = ");
844847
}

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -528,6 +528,7 @@ public enum Message {
528528
MISSING_ARGUMENTS("'missing' can only be used for arguments"),
529529
INVALID_ENVIRONMENT("invalid environment"),
530530
INVALID_ENVIRONMENT_SPECIFIED("invalid environment specified"),
531+
ARG_MUST_BE_ENV("argument must be an environment"),
531532
ENVIR_NOT_LENGTH_ONE("numeric 'envir' arg not of length one"),
532533
FMT_NOT_CHARACTER("'fmt' is not a character vector"),
533534
UNSUPPORTED_TYPE("unsupported type"),

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

Lines changed: 90 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -528,7 +528,7 @@ Use showMethods("gen") for currently available ones.
528528
[1] 42
529529
[1] 42
530530

531-
##com.oracle.truffle.r.test.S4.TestS4.testMethods#
531+
##com.oracle.truffle.r.test.S4.TestS4.testMethods#Output.IgnoreWarningMessage#
532532
#{ setClass("foo"); setMethod("diag<-", "foo", function(x, value) 42); removeMethod("diag<-", "foo"); removeGeneric("diag<-"); removeClass("foo") }
533533
Creating a generic function for ‘diag<-’ from package ‘base’ in the global environment
534534
[1] TRUE
@@ -26933,6 +26933,95 @@ logical(0)
2693326933
#{ v <- .Internal(eSoftVersion()); !is.null(v) && length(v) > 0 }
2693426934
[1] TRUE
2693526935

26936+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26937+
#{ e <- new.env(); e$a <- 1; e$b <- 2; e$z <- 100; e$.a <- 'dot.a'; l <- eapply(e, function(v) {v}, all.names=F); l[order(names(l))] }
26938+
$a
26939+
[1] 1
26940+
26941+
$b
26942+
[1] 2
26943+
26944+
$z
26945+
[1] 100
26946+
26947+
26948+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26949+
#{ e <- new.env(); e$a <- 1; e$b <- 2; e$z <- 100; e$.a <- 'dot.a'; l <- eapply(e, function(v) {v}, all.names=T); l[order(names(l))] }
26950+
$.a
26951+
[1] "dot.a"
26952+
26953+
$a
26954+
[1] 1
26955+
26956+
$b
26957+
[1] 2
26958+
26959+
$z
26960+
[1] 100
26961+
26962+
26963+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26964+
#{ e <- new.env(); e$a <- 1; e$b <- 2; e$z <- 100; e$.a <- 'dot.a'; l <- eapply(e, function(v) {v}, all.names=T, USE.NAMES=F); l[order(names(l))] }
26965+
Error in order(names(l)) : argument 1 is not a vector
26966+
26967+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26968+
#{ e <- new.env(); e$a <- 1; e$b <- 2; e$z <- 100; e$.a <- 'dot.a'; l <- eapply(e, function(v) {v}, all.names=T, USE.NAMES=T); l[order(names(l))] }
26969+
$.a
26970+
[1] "dot.a"
26971+
26972+
$a
26973+
[1] 1
26974+
26975+
$b
26976+
[1] 2
26977+
26978+
$z
26979+
[1] 100
26980+
26981+
26982+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#Output.IgnoreErrorContext#
26983+
#{ eapply() }
26984+
Error in match.fun(FUN) : argument "FUN" is missing, with no default
26985+
26986+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26987+
#{ eapply(1, function(v) {v}) }
26988+
Error in eapply(1, function(v) { : argument must be an environment
26989+
26990+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26991+
#{ eapply(FUN=function(v) {v}) }
26992+
Error in eapply(FUN = function(v) { :
26993+
argument "env" is missing, with no default
26994+
26995+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
26996+
#{ eapply(list2env(list(a=1)), function(v) {sys.call()}) }
26997+
$a
26998+
FUN(X[[i]], ...)
26999+
27000+
27001+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#Output.IgnoreErrorContext#
27002+
#{ eapply(new.env()) }
27003+
Error in match.fun(FUN) : argument "FUN" is missing, with no default
27004+
27005+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#Output.IgnoreErrorContext#
27006+
#{ eapply(new.env(), 1) }
27007+
Error in match.fun(FUN) : '1' is not a function, character or symbol
27008+
27009+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
27010+
#{ eapply(new.env(), function(v) {v}, all.names='abc') }
27011+
named list()
27012+
27013+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
27014+
#{ eapply(new.env(), function(v) {v}, all.names=NA) }
27015+
named list()
27016+
27017+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
27018+
#{ eapply(new.env(), function(v) {v}, all.names=T, USE.NAMES='abc') }
27019+
list()
27020+
27021+
##com.oracle.truffle.r.test.builtins.TestBuiltin_eapply.testLapply#
27022+
#{ eapply(new.env(), function(v) {v}, all.names=T, USE.NAMES=NA) }
27023+
list()
27024+
2693627025
##com.oracle.truffle.r.test.builtins.TestBuiltin_enc2native.testInvalidArguments#Output.IgnoreErrorMessage#
2693727026
#enc2native(42);
2693827027
Error in enc2native(42) : argument is not a character vector
Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
/*
2+
* Copyright (c) 2018, Oracle and/or its affiliates. All rights reserved.
3+
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4+
*
5+
* This code is free software; you can redistribute it and/or modify it
6+
* under the terms of the GNU General Public License version 3 only, as
7+
* published by the Free Software Foundation.
8+
*
9+
* This code is distributed in the hope that it will be useful, but WITHOUT
10+
* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
11+
* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12+
* version 3 for more details (a copy is included in the LICENSE file that
13+
* accompanied this code).
14+
*
15+
* You should have received a copy of the GNU General Public License version
16+
* 3 along with this work; if not, write to the Free Software Foundation,
17+
* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
18+
*
19+
* Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
20+
* or visit www.oracle.com if you need additional information or have any
21+
* questions.
22+
*/
23+
package com.oracle.truffle.r.test.builtins;
24+
25+
import org.junit.Test;
26+
27+
import com.oracle.truffle.r.test.TestBase;
28+
29+
// Checkstyle: stop line length check
30+
31+
public class TestBuiltin_eapply extends TestBase {
32+
33+
@Test
34+
public void testLapply() {
35+
assertEval(Output.IgnoreErrorContext, "{ eapply() }");
36+
assertEval("{ eapply(new.env(), 1) }");
37+
assertEval(Output.IgnoreErrorContext, "{ eapply(new.env()) }");
38+
assertEval("{ eapply(FUN=function(v) {v}) }");
39+
assertEval("{ eapply(1, function(v) {v}) }");
40+
assertEval("{ eapply(new.env(), function(v) {v}, all.names='abc') }");
41+
assertEval("{ eapply(new.env(), function(v) {v}, all.names=NA) }");
42+
assertEval("{ eapply(new.env(), function(v) {v}, all.names=T, USE.NAMES='abc') }");
43+
assertEval("{ eapply(new.env(), function(v) {v}, all.names=T, USE.NAMES=NA) }");
44+
45+
String env = "e <- new.env(); e$a <- 1; e$b <- 2; e$z <- 100; e$.a <- 'dot.a';";
46+
assertEval("{ " + env + " l <- eapply(e, function(v) {v}, all.names=T); l[order(names(l))] }");
47+
assertEval("{ " + env + " l <- eapply(e, function(v) {v}, all.names=F); l[order(names(l))] }");
48+
assertEval("{ " + env + " l <- eapply(e, function(v) {v}, all.names=T, USE.NAMES=T); l[order(names(l))] }");
49+
assertEval("{ " + env + " l <- eapply(e, function(v) {v}, all.names=T, USE.NAMES=F); l[order(names(l))] }");
50+
51+
assertEval("{ eapply(list2env(list(a=1)), function(v) {sys.call()}) }");
52+
53+
}
54+
55+
}

0 commit comments

Comments
 (0)