From 6224ba9f0eb9f692fa2651a7796cc2d5e321163a Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Mon, 29 Jan 2018 19:26:27 +0100
Subject: [PATCH] CAR/CDR and related macros refactored + support for RSymbol
and RNull for all variants
---
.../r/ffi/impl/nodes/ListAccessNodes.java | 253 ++++++++----------
.../testrffi/testrffi/tests/simpleTests.R | 5 +
2 files changed, 111 insertions(+), 147 deletions(-)
diff --git a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
index 61fa874e2c..b18eaf5c49 100644
--- a/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
+++ b/com.oracle.truffle.r.ffi.impl/src/com/oracle/truffle/r/ffi/impl/nodes/ListAccessNodes.java
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2017, 2017, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2017, 2018, 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
@@ -26,15 +26,7 @@ import com.oracle.truffle.api.dsl.Cached;
import com.oracle.truffle.api.dsl.Fallback;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.api.dsl.TypeSystemReference;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CAARNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CAD4RNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADDDRNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADDRNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CADRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CARNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDARNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDDDRNodeGen;
-import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.CDRNodeGen;
import com.oracle.truffle.r.ffi.impl.nodes.ListAccessNodesFactory.SETCARNodeGen;
import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
@@ -98,57 +90,6 @@ public final class ListAccessNodes {
}
}
- @TypeSystemReference(RTypes.class)
- public abstract static class CAARNode extends FFIUpCallNode.Arg1 {
-
- @Child private CARNode car1 = CARNode.create();
- @Child private CARNode car2 = CARNode.create();
-
- @Specialization
- protected Object caar(Object value) {
- return car2.executeObject(car1.executeObject(value));
- }
-
- public static CAARNode create() {
- return CAARNodeGen.create();
- }
- }
-
- @TypeSystemReference(RTypes.class)
- public static final class SETCADRNode extends FFIUpCallNode.Arg2 {
- @Child private SETCARNode setcarNode = SETCARNode.create();
- @Child private CDRNode cdrNode = CDRNode.create();
-
- @Override
- public Object executeObject(Object x, Object y) {
- return setcarNode.executeObject(cdrNode.executeObject(x), y);
- }
- }
-
- @TypeSystemReference(RTypes.class)
- public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
- public static SETCARNode create() {
- return SETCARNodeGen.create();
- }
-
- @Specialization
- protected Object doRLang(RLanguage x, Object y) {
- x.getPairList().setCar(y);
- return y;
- }
-
- @Specialization
- protected Object doRLang(RPairList x, Object y) {
- x.setCar(y);
- return y;
- }
-
- @Fallback
- protected Object car(@SuppressWarnings("unused") Object x, @SuppressWarnings("unused") Object y) {
- throw RInternalError.unimplemented("SETCAR only works on pair lists or language objects");
- }
- }
-
@TypeSystemReference(RTypes.class)
public abstract static class CDRNode extends FFIUpCallNode.Arg1 {
@Specialization
@@ -183,6 +124,16 @@ public final class ListAccessNodes {
return copy;
}
+ @Specialization
+ protected RNull cdr(@SuppressWarnings("unused") RSymbol symbol) {
+ return RNull.instance;
+ }
+
+ @Specialization
+ protected RNull handleNull(@SuppressWarnings("unused") RNull rNull) {
+ return rNull;
+ }
+
@Fallback
protected Object cdr(@SuppressWarnings("unused") Object obj) {
throw RInternalError.unimplemented("CDR only works on pair lists, language objects, and argument lists");
@@ -194,153 +145,161 @@ public final class ListAccessNodes {
}
@TypeSystemReference(RTypes.class)
- public abstract static class CADRNode extends FFIUpCallNode.Arg1 {
+ public static final class CAARNode extends FFIUpCallNode.Arg1 {
+
+ @Child private CARNode car1 = CARNode.create();
+ @Child private CARNode car2 = CARNode.create();
+
+ @Override
+ public Object executeObject(Object x) {
+ return car2.executeObject(car1.executeObject(x));
+ }
+
+ public static CAARNode create() {
+ return new CAARNode();
+ }
+ }
+
+ @TypeSystemReference(RTypes.class)
+ public static final class SETCADRNode extends FFIUpCallNode.Arg2 {
+ @Child private SETCARNode setcarNode = SETCARNode.create();
+ @Child private CDRNode cdrNode = CDRNode.create();
+
+ @Override
+ public Object executeObject(Object x, Object y) {
+ return setcarNode.executeObject(cdrNode.executeObject(x), y);
+ }
+ }
+
+ @TypeSystemReference(RTypes.class)
+ public abstract static class SETCARNode extends FFIUpCallNode.Arg2 {
+ public static SETCARNode create() {
+ return SETCARNodeGen.create();
+ }
+
@Specialization
- protected Object cadr(RPairList pl) {
- return pl.cadr();
+ protected Object doRLang(RLanguage x, Object y) {
+ x.getPairList().setCar(y);
+ return y;
}
@Specialization
- protected Object cadr(RLanguage lang) {
- return lang.getDataAtAsObject(1);
+ protected Object doRPairList(RPairList x, Object y) {
+ x.setCar(y);
+ return y;
}
@Fallback
- protected Object cadr(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CADR only works on pair lists and language objects");
+ protected Object car(@SuppressWarnings("unused") Object x, @SuppressWarnings("unused") Object y) {
+ throw RInternalError.unimplemented("SETCAR only works on pair lists or language objects");
+ }
+ }
+
+ @TypeSystemReference(RTypes.class)
+ public static final class CADRNode extends FFIUpCallNode.Arg1 {
+ @Child private CDRNode cdr = CDRNode.create();
+ @Child private CARNode car = CARNode.create();
+
+ @Override
+ public Object executeObject(Object x) {
+ return car.executeObject(cdr.executeObject(x));
}
public static CADRNode create() {
- return CADRNodeGen.create();
+ return new CADRNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CDARNode extends FFIUpCallNode.Arg1 {
+ public static final class CDARNode extends FFIUpCallNode.Arg1 {
@Child private CARNode car = CARNode.create();
@Child private CDRNode cdr = CDRNode.create();
- @Specialization
- protected Object cdar(Object value) {
- return cdr.executeObject(car.executeObject(value));
+ @Override
+ public Object executeObject(Object x) {
+ return cdr.executeObject(car.executeObject(x));
}
public static CDARNode create() {
- return CDARNodeGen.create();
+ return new CDARNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CADDRNode extends FFIUpCallNode.Arg1 {
- @Specialization
- protected Object caddr(RPairList pl) {
- return pl.caddr();
- }
-
- @Specialization
- protected Object caddr(RLanguage lang) {
- return lang.getDataAtAsObject(2);
- }
+ public static final class CADDRNode extends FFIUpCallNode.Arg1 {
+ @Child private CARNode car = CARNode.create();
+ @Child private CDRNode cdr1 = CDRNode.create();
+ @Child private CDRNode cdr2 = CDRNode.create();
- @Fallback
- protected Object caddr(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CADDR only works on pair lists and language objects");
+ @Override
+ public Object executeObject(Object x) {
+ return car.executeObject(cdr1.executeObject(cdr2.executeObject(x)));
}
public static CADDRNode create() {
- return CADDRNodeGen.create();
+ return new CADDRNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CADDDRNode extends FFIUpCallNode.Arg1 {
- @Specialization
- protected Object cadddr(RPairList pl) {
- RPairList tmp = (RPairList) pl.cddr();
- return tmp.cadr();
- }
-
- @Specialization
- protected Object cadddr(RLanguage lang) {
- return lang.getDataAtAsObject(3);
- }
+ public static final class CADDDRNode extends FFIUpCallNode.Arg1 {
+ @Child private CARNode car = CARNode.create();
+ @Child private CDRNode cdr1 = CDRNode.create();
+ @Child private CDRNode cdr2 = CDRNode.create();
+ @Child private CDRNode cdr3 = CDRNode.create();
- @Fallback
- protected Object cadddr(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CADDDR only works on pair lists and language objects");
+ @Override
+ public Object executeObject(Object x) {
+ return car.executeObject(cdr1.executeObject(cdr2.executeObject(cdr3.executeObject(x))));
}
public static CADDDRNode create() {
- return CADDDRNodeGen.create();
+ return new CADDDRNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CAD4RNode extends FFIUpCallNode.Arg1 {
- @Specialization
- protected Object cad4r(RPairList pl) {
- RPairList tmp = (RPairList) pl.cddr();
- return tmp.caddr();
- }
-
- @Specialization
- protected Object cad4r(RLanguage lang) {
- return lang.getDataAtAsObject(4);
- }
+ public static final class CAD4RNode extends FFIUpCallNode.Arg1 {
+ @Child private CADDDRNode cadddr = CADDDRNode.create();
+ @Child private CDRNode cdr = CDRNode.create();
- @Fallback
- protected Object cad4r(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CAD4R only works on pair lists and language objects");
+ @Override
+ public Object executeObject(Object x) {
+ return cadddr.executeObject(cdr.executeObject(x));
}
public static CAD4RNode create() {
- return CAD4RNodeGen.create();
+ return new CAD4RNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CDDRNode extends FFIUpCallNode.Arg1 {
- @Specialization
- protected Object cddr(RPairList pl) {
- return pl.cddr();
- }
+ public static final class CDDRNode extends FFIUpCallNode.Arg1 {
+ @Child private CDRNode cdr1 = CDRNode.create();
+ @Child private CDRNode cdr2 = CDRNode.create();
- @Specialization
- protected Object cddr(RLanguage lang) {
- RPairList l = lang.getPairList();
- return l.cddr();
- }
-
- @Fallback
- protected Object cddr(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CDDR only works on pair lists and language objects");
+ @Override
+ public Object executeObject(Object x) {
+ return cdr1.executeObject(cdr2.executeObject(x));
}
public static CDDRNode create() {
- return CDDRNodeGen.create();
+ return new CDDRNode();
}
}
@TypeSystemReference(RTypes.class)
- public abstract static class CDDDRNode extends FFIUpCallNode.Arg1 {
- @Specialization
- protected Object cdddr(RPairList pl) {
- return pl.cddr();
- }
-
- @Specialization
- protected Object cdddr(RLanguage lang) {
- RPairList l = (RPairList) lang.getPairList().cddr();
- return l.cdr();
- }
+ public static final class CDDDRNode extends FFIUpCallNode.Arg1 {
+ @Child CDDRNode cddr = CDDRNode.create();
+ @Child CDRNode cdr = CDRNode.create();
- @Fallback
- protected Object cdddr(@SuppressWarnings("unused") Object obj) {
- throw RInternalError.unimplemented("CDDDR only works on pair lists and language objects");
+ @Override
+ public Object executeObject(Object x) {
+ return cdr.executeObject(cddr.executeObject(x));
}
public static CDDDRNode create() {
- return CDDDRNodeGen.create();
+ return new CDDDRNode();
}
}
}
diff --git a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
index cf85ab25b3..be9770bc6c 100644
--- a/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
+++ b/com.oracle.truffle.r.test.native/packages/testrffi/testrffi/tests/simpleTests.R
@@ -114,3 +114,8 @@ for(i in seq(5000)) {
# Following code calls Rf_eval with a language object that contains a promise instead of the expected function
set.seed(42)
rffi.RfEvalWithPromiseInPairList()
+
+# CAR/CDR tests
+rffi.CAR(NULL)
+rffi.CDR(NULL)
+rffi.CAR(as.symbol('a'))
--
GitLab